From bdea50f2baa8f866a77d355ef23a1ba844f8c2b7 Mon Sep 17 00:00:00 2001 From: dos-reis Date: Thu, 11 Oct 2007 08:33:03 +0000 Subject: Remove more pamphlet files --- src/interp/bc-matrix.boot | 155 ++ src/interp/bc-matrix.boot.pamphlet | 177 -- src/interp/nag-c02.boot | 296 +++ src/interp/nag-c02.boot.pamphlet | 318 --- src/interp/nag-c05.boot | 404 ++++ src/interp/nag-c05.boot.pamphlet | 426 ---- src/interp/nag-c06.boot | 1834 ++++++++++++++ src/interp/nag-c06.boot.pamphlet | 1856 -------------- src/interp/nag-d01.boot | 1339 ++++++++++ src/interp/nag-d01.boot.pamphlet | 1361 ----------- src/interp/nag-d02.boot | 2148 +++++++++++++++++ src/interp/nag-d02.boot.pamphlet | 2170 ----------------- src/interp/nag-d03.boot | 641 +++++ src/interp/nag-d03.boot.pamphlet | 663 ----- src/interp/nag-e01.boot | 1760 ++++++++++++++ src/interp/nag-e01.boot.pamphlet | 1782 -------------- src/interp/nag-e02.boot | 4673 +++++++++++++++++++++++++++++++++++ src/interp/nag-e02.boot.pamphlet | 4695 ------------------------------------ src/interp/nag-e02b.boot | 1737 +++++++++++++ src/interp/nag-e02b.boot.pamphlet | 1759 -------------- src/interp/nag-e04.boot | 2500 +++++++++++++++++++ src/interp/nag-e04.boot.pamphlet | 2522 ------------------- src/interp/nag-f01.boot | 2232 +++++++++++++++++ src/interp/nag-f01.boot.pamphlet | 2254 ----------------- src/interp/nag-f02.boot | 2735 +++++++++++++++++++++ src/interp/nag-f02.boot.pamphlet | 2757 --------------------- src/interp/nag-f04.boot | 2311 ++++++++++++++++++ src/interp/nag-f04.boot.pamphlet | 2333 ------------------ src/interp/nag-f07.boot | 706 ++++++ src/interp/nag-f07.boot.pamphlet | 728 ------ src/interp/nag-s.boot | 1584 ++++++++++++ src/interp/nag-s.boot.pamphlet | 1606 ------------ src/interp/showimp.boot | 252 ++ src/interp/showimp.boot.pamphlet | 278 --- src/interp/topics.boot.pamphlet | 263 -- 35 files changed, 27307 insertions(+), 27948 deletions(-) create mode 100644 src/interp/bc-matrix.boot delete mode 100644 src/interp/bc-matrix.boot.pamphlet create mode 100644 src/interp/nag-c02.boot delete mode 100644 src/interp/nag-c02.boot.pamphlet create mode 100644 src/interp/nag-c05.boot delete mode 100644 src/interp/nag-c05.boot.pamphlet create mode 100644 src/interp/nag-c06.boot delete mode 100644 src/interp/nag-c06.boot.pamphlet create mode 100644 src/interp/nag-d01.boot delete mode 100644 src/interp/nag-d01.boot.pamphlet create mode 100644 src/interp/nag-d02.boot delete mode 100644 src/interp/nag-d02.boot.pamphlet create mode 100644 src/interp/nag-d03.boot delete mode 100644 src/interp/nag-d03.boot.pamphlet create mode 100644 src/interp/nag-e01.boot delete mode 100644 src/interp/nag-e01.boot.pamphlet create mode 100644 src/interp/nag-e02.boot delete mode 100644 src/interp/nag-e02.boot.pamphlet create mode 100644 src/interp/nag-e02b.boot delete mode 100644 src/interp/nag-e02b.boot.pamphlet create mode 100644 src/interp/nag-e04.boot delete mode 100644 src/interp/nag-e04.boot.pamphlet create mode 100644 src/interp/nag-f01.boot delete mode 100644 src/interp/nag-f01.boot.pamphlet create mode 100644 src/interp/nag-f02.boot delete mode 100644 src/interp/nag-f02.boot.pamphlet create mode 100644 src/interp/nag-f04.boot delete mode 100644 src/interp/nag-f04.boot.pamphlet create mode 100644 src/interp/nag-f07.boot delete mode 100644 src/interp/nag-f07.boot.pamphlet create mode 100644 src/interp/nag-s.boot delete mode 100644 src/interp/nag-s.boot.pamphlet create mode 100644 src/interp/showimp.boot delete mode 100644 src/interp/showimp.boot.pamphlet delete mode 100644 src/interp/topics.boot.pamphlet diff --git a/src/interp/bc-matrix.boot b/src/interp/bc-matrix.boot new file mode 100644 index 00000000..bf1d349c --- /dev/null +++ b/src/interp/bc-matrix.boot @@ -0,0 +1,155 @@ +-- 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. + + +)package "BOOT" + +-- Basic Command matrix entry + +bcMatrix() == bcReadMatrix nil + +bcReadMatrix exitFunctionOrNil == + page := htInitPage('"Matrix Basic Command", nil) + htpSetProperty(page,'exitFunction,exitFunctionOrNil) + htMakePage + '((domainConditions + (isDomain PI (PositiveInteger))) + (text . "Enter the size of the matrix:") + (inputStrings + ("Number of {\em rows}:\space{3}" "" 5 2 rows PI) + ("Number of {\em columns}: " "" 5 2 cols PI)) + (text . "\blankline ") + (text . "How would you like to enter the matrix?") + (text . "\beginmenu") + (text . "\item ") + (bcLinks ("\menuitemstyle{By entering individual entries}" "" bcInputExplicitMatrix explicit)) + (text . "\item ") + (bcLinks ("\menuitemstyle{By formula}" "" bcInputMatrixByFormula formula)) + (text . "\endmenu")) + htShowPage() + +bcInputMatrixByFormula(htPage,junk) == + page := htInitPage('"Basic Matrix Command", htpPropertyList htPage) + htMakePage '( + (domainConditions + (isDomain S (Symbol)) + (isDomain FE (Expression (Integer)))) + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the {\em row variable}: ") + (text . "\tab{36}") + (bcStrings (6 i rowVar S)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the {\em column variable}: ") + (text . "\tab{36}") + (bcStrings (6 j colVar S)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the general {\em formula} for the entries:") + (text . "\newline\tab{2} ") + (bcStrings (40 "1/(x - i - j - 1)" formula FE))) + htMakeDoneButton('"Continue", 'bcInputMatrixByFormulaGen) + nrows := + null $bcParseOnly => objValUnwrap htpLabelSpadValue(htPage,'rows) + PARSE_-INTEGER htpLabelInputString(htPage,'rows) + ncols := + null $bcParseOnly => objValUnwrap htpLabelSpadValue(htPage,'cols) + PARSE_-INTEGER htpLabelInputString(htPage,'cols) + htpSetProperty(page, 'nrows, nrows) + htpSetProperty(page, 'ncols, ncols) + htShowPage() + +bcInputMatrixByFormulaGen htPage == + fun := htpProperty(htPage,'exitFunction) => FUNCALL(fun, htPage) + formula := htpLabelInputString(htPage,'formula) + rowVar := htpLabelInputString(htPage,'rowVar) + colVar := htpLabelInputString(htPage,'colVar) + nrows := htpProperty(htPage,'nrows) + ncols := htpProperty(htPage,'ncols) + bcGen STRCONC('"matrix([[",formula,'" for ",colVar,'" in 1..", + STRINGIMAGE ncols,'"] for ",rowVar,'" in 1..",STRINGIMAGE nrows,'"])") + +bcInputExplicitMatrix(htPage,junk) == + nrows := + null $bcParseOnly => objValUnwrap htpLabelSpadValue(htPage,'rows) + PARSE_-INTEGER htpLabelInputString(htPage,'rows) + ncols := + null $bcParseOnly => objValUnwrap htpLabelSpadValue(htPage,'cols) + PARSE_-INTEGER htpLabelInputString(htPage,'cols) + cond := nil + k := 0 + wrows := # STRINGIMAGE nrows + wcols := # STRINGIMAGE ncols + labelList := + "append"/[[f for j in 1..ncols] for i in 1..nrows] where f() == + rowpart := STRCONC('"{\em Row",htStringPad(i,wrows)) + colpart := STRCONC('", Column",htStringPad(j,wcols),'":}\space{2}") + prefix := STRCONC(rowpart,colpart) + -- name := INTERN STRCONC(htMkName('"row",i),htMkName('"col",j)) + name := INTERN STRINGIMAGE (k := k + 1) + [prefix,'"",30, 0,name,'P] + labelList := + [['domainConditions, '(isDomain P (Polynomial $EmptyMode)), cond], + ['inputStrings, :labelList] ] + page := htInitPage('"Solve Basic Command", htpPropertyList htPage) + bcHt '"Enter the entries of the matrix:" + htMakePage labelList + htMakeDoneButton('"Continue", 'bcGenExplicitMatrix) + htpSetProperty(page,'nrows,nrows) + htpSetProperty(page,'ncols,ncols) + htShowPage() + +bcGenExplicitMatrix htPage == + htpSetProperty(htPage,'matrix,htpInputAreaAlist htPage) + fun := htpProperty(htPage,'exitFunction) => FUNCALL(fun, htPage) + bcGen bcMatrixGen htPage + +bcMatrixGen htPage == + nrows := htpProperty(htPage,'nrows) + ncols := htpProperty(htPage,'ncols) + mat := htpProperty(htPage,'matrix) + formula := LASSOC('formula,mat) => + formula := formula.0 + rowVar := (LASSOC('rowVar,mat)).0 + colVar := (LASSOC('colVar,mat)).0 + STRCONC('"matrix([[",formula,'" for ",colVar,'" in 1..", + STRINGIMAGE ncols,'"] for ",rowVar,'" in 1..",STRINGIMAGE nrows,'"])") + mat := htpProperty(htPage,'matrix) => + mat := REVERSE mat + k := -1 + matform := [[mat.(k := k + 1).1 + for j in 0..(ncols-1)] for i in 0..(nrows-1)] + matstring := bcwords2liststring [bcwords2liststring x for x in matform] + STRCONC('"matrix(",matstring,'")") + systemError nil + diff --git a/src/interp/bc-matrix.boot.pamphlet b/src/interp/bc-matrix.boot.pamphlet deleted file mode 100644 index 30cee0d0..00000000 --- a/src/interp/bc-matrix.boot.pamphlet +++ /dev/null @@ -1,177 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp bc-matrix.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. - -@ -<<*>>= -<> - -)package "BOOT" - --- Basic Command matrix entry - -bcMatrix() == bcReadMatrix nil - -bcReadMatrix exitFunctionOrNil == - page := htInitPage('"Matrix Basic Command", nil) - htpSetProperty(page,'exitFunction,exitFunctionOrNil) - htMakePage - '((domainConditions - (isDomain PI (PositiveInteger))) - (text . "Enter the size of the matrix:") - (inputStrings - ("Number of {\em rows}:\space{3}" "" 5 2 rows PI) - ("Number of {\em columns}: " "" 5 2 cols PI)) - (text . "\blankline ") - (text . "How would you like to enter the matrix?") - (text . "\beginmenu") - (text . "\item ") - (bcLinks ("\menuitemstyle{By entering individual entries}" "" bcInputExplicitMatrix explicit)) - (text . "\item ") - (bcLinks ("\menuitemstyle{By formula}" "" bcInputMatrixByFormula formula)) - (text . "\endmenu")) - htShowPage() - -bcInputMatrixByFormula(htPage,junk) == - page := htInitPage('"Basic Matrix Command", htpPropertyList htPage) - htMakePage '( - (domainConditions - (isDomain S (Symbol)) - (isDomain FE (Expression (Integer)))) - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the {\em row variable}: ") - (text . "\tab{36}") - (bcStrings (6 i rowVar S)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the {\em column variable}: ") - (text . "\tab{36}") - (bcStrings (6 j colVar S)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the general {\em formula} for the entries:") - (text . "\newline\tab{2} ") - (bcStrings (40 "1/(x - i - j - 1)" formula FE))) - htMakeDoneButton('"Continue", 'bcInputMatrixByFormulaGen) - nrows := - null $bcParseOnly => objValUnwrap htpLabelSpadValue(htPage,'rows) - PARSE_-INTEGER htpLabelInputString(htPage,'rows) - ncols := - null $bcParseOnly => objValUnwrap htpLabelSpadValue(htPage,'cols) - PARSE_-INTEGER htpLabelInputString(htPage,'cols) - htpSetProperty(page, 'nrows, nrows) - htpSetProperty(page, 'ncols, ncols) - htShowPage() - -bcInputMatrixByFormulaGen htPage == - fun := htpProperty(htPage,'exitFunction) => FUNCALL(fun, htPage) - formula := htpLabelInputString(htPage,'formula) - rowVar := htpLabelInputString(htPage,'rowVar) - colVar := htpLabelInputString(htPage,'colVar) - nrows := htpProperty(htPage,'nrows) - ncols := htpProperty(htPage,'ncols) - bcGen STRCONC('"matrix([[",formula,'" for ",colVar,'" in 1..", - STRINGIMAGE ncols,'"] for ",rowVar,'" in 1..",STRINGIMAGE nrows,'"])") - -bcInputExplicitMatrix(htPage,junk) == - nrows := - null $bcParseOnly => objValUnwrap htpLabelSpadValue(htPage,'rows) - PARSE_-INTEGER htpLabelInputString(htPage,'rows) - ncols := - null $bcParseOnly => objValUnwrap htpLabelSpadValue(htPage,'cols) - PARSE_-INTEGER htpLabelInputString(htPage,'cols) - cond := nil - k := 0 - wrows := # STRINGIMAGE nrows - wcols := # STRINGIMAGE ncols - labelList := - "append"/[[f for j in 1..ncols] for i in 1..nrows] where f() == - rowpart := STRCONC('"{\em Row",htStringPad(i,wrows)) - colpart := STRCONC('", Column",htStringPad(j,wcols),'":}\space{2}") - prefix := STRCONC(rowpart,colpart) - -- name := INTERN STRCONC(htMkName('"row",i),htMkName('"col",j)) - name := INTERN STRINGIMAGE (k := k + 1) - [prefix,'"",30, 0,name,'P] - labelList := - [['domainConditions, '(isDomain P (Polynomial $EmptyMode)), cond], - ['inputStrings, :labelList] ] - page := htInitPage('"Solve Basic Command", htpPropertyList htPage) - bcHt '"Enter the entries of the matrix:" - htMakePage labelList - htMakeDoneButton('"Continue", 'bcGenExplicitMatrix) - htpSetProperty(page,'nrows,nrows) - htpSetProperty(page,'ncols,ncols) - htShowPage() - -bcGenExplicitMatrix htPage == - htpSetProperty(htPage,'matrix,htpInputAreaAlist htPage) - fun := htpProperty(htPage,'exitFunction) => FUNCALL(fun, htPage) - bcGen bcMatrixGen htPage - -bcMatrixGen htPage == - nrows := htpProperty(htPage,'nrows) - ncols := htpProperty(htPage,'ncols) - mat := htpProperty(htPage,'matrix) - formula := LASSOC('formula,mat) => - formula := formula.0 - rowVar := (LASSOC('rowVar,mat)).0 - colVar := (LASSOC('colVar,mat)).0 - STRCONC('"matrix([[",formula,'" for ",colVar,'" in 1..", - STRINGIMAGE ncols,'"] for ",rowVar,'" in 1..",STRINGIMAGE nrows,'"])") - mat := htpProperty(htPage,'matrix) => - mat := REVERSE mat - k := -1 - matform := [[mat.(k := k + 1).1 - for j in 0..(ncols-1)] for i in 0..(nrows-1)] - matstring := bcwords2liststring [bcwords2liststring x for x in matform] - STRCONC('"matrix(",matstring,'")") - systemError nil - -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/nag-c02.boot b/src/interp/nag-c02.boot new file mode 100644 index 00000000..a7cf81f6 --- /dev/null +++ b/src/interp/nag-c02.boot @@ -0,0 +1,296 @@ +-- 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. + + +)package "BOOT" + +c02aff() == + htInitPage('"C02AFF - All Zeros of a Complex Polynomial",nil) + htMakePage '( + (domainConditions + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXc02aff} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|c02aff| '|NagPolynomialRootsPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "Finds all the roots of the complex polynomial equation ") + (text . "\htbitmap{c02aff}, using a variant of Laguerre's method. ") + (text . "\blankline ") + (text . "\newline \menuitemstyle{} ") + (text . "\tab{2} Enter the degree {\em n} of the polynomial:") + (text . "\newline\tab{2} ") + (bcStrings (5 5 n PI)) + (text . "\blankline") + (text . "\newline") + (text . "\newline \menuitemstyle{} \tab{2} Scale value:") + (radioButtons scale + ("" " True" true) + ("" " False" false)) + (text . "\blankline ") + (text . "\newline \menuitemstyle{} \tab{2} Ifail value:") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'c02affSolve) + htShowPage() + +c02affSolve htPage == + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + logical := htpButtonValue(htPage,'scale) + scale := + logical = 'true => '"true" + '"false" + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + n = '5 => c02affDefaultSolve(htPage,scale,ifail) + labelList := + "append"/[f(i,n) for i in 1..(n+1)] where f(i,n) == + prefix := ('"\newline z**") + prefix := STRCONC(prefix,STRINGIMAGE (n-i+1),'"\space{1}") + post := ('"\tab{30} ") + post := STRCONC(post,'"\space{1}") + rnam := INTERN STRCONC ('"r",STRINGIMAGE i) + inam := INTERN STRCONC ('"i",STRINGIMAGE i) + [['text,:prefix],['bcStrings,[10, 0.0, rnam, 'P]], + ['text,:post],['bcStrings,[10, 0.0, inam, 'P]]] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain PI (PositiveInteger))), + :labelList] + page := htInitPage("C02AFF - All Zeros of a Complex Polynomial", htpPropertyList htPage) + htSay '"\menuitemstyle{} \tab{2} Enter the coefficients of the polynomial: " + htSay '"\blankline " + htSay '"Real parts \tab{30} Imaginary parts " + htSay '"\newline " + htMakePage equationPart + htMakeDoneButton('"Continue",'c02affGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'scale,scale) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +c02affDefaultSolve (htPage, scale, ifail) == + n := '5 + page := htInitPage('"C02AFF - All Zeros of a Complex Polynomial",nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\newline \menuitemstyle{} \tab{2} ") + (text . "Enter the coefficients of the polynomial: ") + (text . "\blankline ") + (text . "Real parts \tab{30} Imaginary parts ") + (text . "\newline z**5 \space{1} ") + (bcStrings (10 "5.0" r1 F)) + (text . "\tab{30} ") + (text . "\space{1} ") + (bcStrings (10 "6.0" i1 F)) + (text . "\newline ") + (text . "z**4 \space{1} ") + (bcStrings (10 "30.0" r2 F)) + (text . "\tab{30} ") + (text . "\space{1} ") + (bcStrings (10 "20.0" i2 F)) + (text . "\newline ") + (text . "z**3 \space{1} ") + (bcStrings (10 "-0.2" r3 F)) + (text . "\tab{30} ") + (text . "\space{1} ") + (bcStrings (10 "-6.0" i3 F)) + (text . "\newline ") + (text . "z**2 \space{1} ") + (bcStrings (10 "50.0" r4 F)) + (text . "\tab{30} ") + (text . "\space{1} ") + (bcStrings (10 "100000.0" i4 F)) + (text . "\newline ") + (text . "z**1 \space{1} ") + (bcStrings (10 "-2.0" r5 F)) + (text . "\tab{30} ") + (text . "\space{1} ") + (bcStrings (10 "40.0" i5 F)) + (text . "\newline ") + (text . "z**0 \space{1} ") + (bcStrings (10 "10.0" r6 F)) + (text . "\tab{30} ") + (text . "\space{1} ") + (bcStrings (10 "1.0" i6 F)) + (text . "\newline ") + (text . "\blankline")) + htMakeDoneButton('"Continue",'c02affGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'scale,scale) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +c02affGen htPage == + n := htpProperty(htPage,'n) + scale := htpProperty(htPage,'scale) + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + while y repeat + right := STRCONC((first y).1," ") + y := rest y + left := STRCONC((first y).1," ") + y := rest y + reallist := [left,:reallist] + imaglist := [right,:imaglist] + realstring := bcwords2liststring reallist + imagstring := bcwords2liststring imaglist + linkGen STRCONC ('"c02aff([",realstring,",",imagstring,"],",STRINGIMAGE n,",",scale,",",STRINGIMAGE ifail,")") + +c02agf() == + htInitPage('"C02AGF - All Zeros of a Real Polynomial",nil) + htMakePage '( + (domainConditions + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXc02agf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|c02agf| '|NagPolynomialRootsPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "Finds all the roots of the real polynomial equation ") + (text . "\htbitmap{c02aff}, using a variant of Laguerre's method. ") + (text . "\blankline ") + (text . "\newline \menuitemstyle{} ") + (text . "\tab{2} Enter the degree {\em n} of the polynomial:") + (text . "\newline\tab{2} ") + (bcStrings (5 5 n PI)) + (text . "\blankline") + (text . "\newline") + (text . "\newline \menuitemstyle{} \tab{2} Scale value:") + (radioButtons scale + ("" " True" true) + ("" " False" false)) + (text . "\blankline ") + (text . "\newline \menuitemstyle{} \tab{2} Ifail value:") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'c02agfSolve) + htShowPage() + +c02agfSolve htPage == + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + logical := htpButtonValue(htPage,'scale) + scale := + logical = 'true => '"true" + '"false" + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + n = '5 => c02agfDefaultSolve(htPage,scale,ifail) + labelList := + "append"/[f(i,n) for i in 1..(n+1)] where f(i,n) == + prefix := ('"\newline z**") + prefix := STRCONC(prefix,STRINGIMAGE (n-i+1),'"\space{1}") + rnam := INTERN STRCONC ('"r",STRINGIMAGE i) + [['text,:prefix],['bcStrings,[10, 0.0, rnam, 'P]]] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain PI (PositiveInteger))), + :labelList] + page := htInitPage("C02AGF - All Zeros of a Real Polynomial", htpPropertyList htPage) + htSay '"\menuitemstyle{} \tab{2} " + htSay '"Enter the coefficients of the polynomial: " + htSay '"\newline " + htMakePage equationPart + htMakeDoneButton('"Continue",'c02agfGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'scale,scale) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +c02agfDefaultSolve (htPage, scale, ifail) == + n := '5 + page := htInitPage('"C02AGF - All Zeros of a Real Polynomial",nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\newline \menuitemstyle{} \tab{2} ") + (text . "Enter the coefficients of the polynomial: ") + (text . "\newline ") + (text . "z**5 \space{1} ") + (bcStrings (10 "1.0" r1 F)) + (text . "\newline ") + (text . "z**4 \space{1} ") + (bcStrings (10 "2.0" r2 F)) + (text . "\newline ") + (text . "z**3 \space{1} ") + (bcStrings (10 "3.0" r3 F)) + (text . "\newline ") + (text . "z**2 \space{1} ") + (bcStrings (10 "4.0" r4 F)) + (text . "\newline ") + (text . "z**1 \space{1} ") + (bcStrings (10 "5.0" r5 F)) + (text . "\newline ") + (text . "z**0 \space{1} ") + (bcStrings (10 "6.0" r6 F)) + (text . "\newline ") + (text . "\blankline")) + htMakeDoneButton('"Continue",'c02agfGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'scale,scale) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +c02agfGen htPage == + n := htpProperty(htPage,'n) + scale := htpProperty(htPage,'scale) + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + while y repeat + left := STRCONC((first y).1," ") + y := rest y + reallist := [left,:reallist] + realstring := bcwords2liststring reallist + linkGen STRCONC ('"c02agf([",realstring,"],",STRINGIMAGE n,",",scale,",",STRINGIMAGE ifail,")") + + diff --git a/src/interp/nag-c02.boot.pamphlet b/src/interp/nag-c02.boot.pamphlet deleted file mode 100644 index 6d0e40db..00000000 --- a/src/interp/nag-c02.boot.pamphlet +++ /dev/null @@ -1,318 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp nag-c02.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. - -@ -<<*>>= -<> - -)package "BOOT" - -c02aff() == - htInitPage('"C02AFF - All Zeros of a Complex Polynomial",nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXc02aff} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|c02aff| '|NagPolynomialRootsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "Finds all the roots of the complex polynomial equation ") - (text . "\htbitmap{c02aff}, using a variant of Laguerre's method. ") - (text . "\blankline ") - (text . "\newline \menuitemstyle{} ") - (text . "\tab{2} Enter the degree {\em n} of the polynomial:") - (text . "\newline\tab{2} ") - (bcStrings (5 5 n PI)) - (text . "\blankline") - (text . "\newline") - (text . "\newline \menuitemstyle{} \tab{2} Scale value:") - (radioButtons scale - ("" " True" true) - ("" " False" false)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{} \tab{2} Ifail value:") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'c02affSolve) - htShowPage() - -c02affSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - logical := htpButtonValue(htPage,'scale) - scale := - logical = 'true => '"true" - '"false" - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - n = '5 => c02affDefaultSolve(htPage,scale,ifail) - labelList := - "append"/[f(i,n) for i in 1..(n+1)] where f(i,n) == - prefix := ('"\newline z**") - prefix := STRCONC(prefix,STRINGIMAGE (n-i+1),'"\space{1}") - post := ('"\tab{30} ") - post := STRCONC(post,'"\space{1}") - rnam := INTERN STRCONC ('"r",STRINGIMAGE i) - inam := INTERN STRCONC ('"i",STRINGIMAGE i) - [['text,:prefix],['bcStrings,[10, 0.0, rnam, 'P]], - ['text,:post],['bcStrings,[10, 0.0, inam, 'P]]] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain PI (PositiveInteger))), - :labelList] - page := htInitPage("C02AFF - All Zeros of a Complex Polynomial", htpPropertyList htPage) - htSay '"\menuitemstyle{} \tab{2} Enter the coefficients of the polynomial: " - htSay '"\blankline " - htSay '"Real parts \tab{30} Imaginary parts " - htSay '"\newline " - htMakePage equationPart - htMakeDoneButton('"Continue",'c02affGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'scale,scale) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -c02affDefaultSolve (htPage, scale, ifail) == - n := '5 - page := htInitPage('"C02AFF - All Zeros of a Complex Polynomial",nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\newline \menuitemstyle{} \tab{2} ") - (text . "Enter the coefficients of the polynomial: ") - (text . "\blankline ") - (text . "Real parts \tab{30} Imaginary parts ") - (text . "\newline z**5 \space{1} ") - (bcStrings (10 "5.0" r1 F)) - (text . "\tab{30} ") - (text . "\space{1} ") - (bcStrings (10 "6.0" i1 F)) - (text . "\newline ") - (text . "z**4 \space{1} ") - (bcStrings (10 "30.0" r2 F)) - (text . "\tab{30} ") - (text . "\space{1} ") - (bcStrings (10 "20.0" i2 F)) - (text . "\newline ") - (text . "z**3 \space{1} ") - (bcStrings (10 "-0.2" r3 F)) - (text . "\tab{30} ") - (text . "\space{1} ") - (bcStrings (10 "-6.0" i3 F)) - (text . "\newline ") - (text . "z**2 \space{1} ") - (bcStrings (10 "50.0" r4 F)) - (text . "\tab{30} ") - (text . "\space{1} ") - (bcStrings (10 "100000.0" i4 F)) - (text . "\newline ") - (text . "z**1 \space{1} ") - (bcStrings (10 "-2.0" r5 F)) - (text . "\tab{30} ") - (text . "\space{1} ") - (bcStrings (10 "40.0" i5 F)) - (text . "\newline ") - (text . "z**0 \space{1} ") - (bcStrings (10 "10.0" r6 F)) - (text . "\tab{30} ") - (text . "\space{1} ") - (bcStrings (10 "1.0" i6 F)) - (text . "\newline ") - (text . "\blankline")) - htMakeDoneButton('"Continue",'c02affGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'scale,scale) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -c02affGen htPage == - n := htpProperty(htPage,'n) - scale := htpProperty(htPage,'scale) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - while y repeat - right := STRCONC((first y).1," ") - y := rest y - left := STRCONC((first y).1," ") - y := rest y - reallist := [left,:reallist] - imaglist := [right,:imaglist] - realstring := bcwords2liststring reallist - imagstring := bcwords2liststring imaglist - linkGen STRCONC ('"c02aff([",realstring,",",imagstring,"],",STRINGIMAGE n,",",scale,",",STRINGIMAGE ifail,")") - -c02agf() == - htInitPage('"C02AGF - All Zeros of a Real Polynomial",nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXc02agf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|c02agf| '|NagPolynomialRootsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "Finds all the roots of the real polynomial equation ") - (text . "\htbitmap{c02aff}, using a variant of Laguerre's method. ") - (text . "\blankline ") - (text . "\newline \menuitemstyle{} ") - (text . "\tab{2} Enter the degree {\em n} of the polynomial:") - (text . "\newline\tab{2} ") - (bcStrings (5 5 n PI)) - (text . "\blankline") - (text . "\newline") - (text . "\newline \menuitemstyle{} \tab{2} Scale value:") - (radioButtons scale - ("" " True" true) - ("" " False" false)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{} \tab{2} Ifail value:") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'c02agfSolve) - htShowPage() - -c02agfSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - logical := htpButtonValue(htPage,'scale) - scale := - logical = 'true => '"true" - '"false" - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - n = '5 => c02agfDefaultSolve(htPage,scale,ifail) - labelList := - "append"/[f(i,n) for i in 1..(n+1)] where f(i,n) == - prefix := ('"\newline z**") - prefix := STRCONC(prefix,STRINGIMAGE (n-i+1),'"\space{1}") - rnam := INTERN STRCONC ('"r",STRINGIMAGE i) - [['text,:prefix],['bcStrings,[10, 0.0, rnam, 'P]]] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain PI (PositiveInteger))), - :labelList] - page := htInitPage("C02AGF - All Zeros of a Real Polynomial", htpPropertyList htPage) - htSay '"\menuitemstyle{} \tab{2} " - htSay '"Enter the coefficients of the polynomial: " - htSay '"\newline " - htMakePage equationPart - htMakeDoneButton('"Continue",'c02agfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'scale,scale) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -c02agfDefaultSolve (htPage, scale, ifail) == - n := '5 - page := htInitPage('"C02AGF - All Zeros of a Real Polynomial",nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\newline \menuitemstyle{} \tab{2} ") - (text . "Enter the coefficients of the polynomial: ") - (text . "\newline ") - (text . "z**5 \space{1} ") - (bcStrings (10 "1.0" r1 F)) - (text . "\newline ") - (text . "z**4 \space{1} ") - (bcStrings (10 "2.0" r2 F)) - (text . "\newline ") - (text . "z**3 \space{1} ") - (bcStrings (10 "3.0" r3 F)) - (text . "\newline ") - (text . "z**2 \space{1} ") - (bcStrings (10 "4.0" r4 F)) - (text . "\newline ") - (text . "z**1 \space{1} ") - (bcStrings (10 "5.0" r5 F)) - (text . "\newline ") - (text . "z**0 \space{1} ") - (bcStrings (10 "6.0" r6 F)) - (text . "\newline ") - (text . "\blankline")) - htMakeDoneButton('"Continue",'c02agfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'scale,scale) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -c02agfGen htPage == - n := htpProperty(htPage,'n) - scale := htpProperty(htPage,'scale) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - while y repeat - left := STRCONC((first y).1," ") - y := rest y - reallist := [left,:reallist] - realstring := bcwords2liststring reallist - linkGen STRCONC ('"c02agf([",realstring,"],",STRINGIMAGE n,",",scale,",",STRINGIMAGE ifail,")") - - -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/nag-c05.boot b/src/interp/nag-c05.boot new file mode 100644 index 00000000..80436694 --- /dev/null +++ b/src/interp/nag-c05.boot @@ -0,0 +1,404 @@ +-- 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. + + +)package "BOOT" + +c05adf() == + htInitPage('"C05ADF - Zero of continuous function in given interval, Bus and Dekker algorithm",nil) + htMakePage '( + (domainConditions + (isDomain EM $EmptyMode) + (isDomain F (Float))) + (text . "\windowlink{Manual Page}{manpageXXc05adf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|c05adf| '|NagRootFindingPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\newline ") + (text . "C05ADF locates a zero of a continuous function in a ") + (text . "interval by a combination of the methods of linear ") + (text . "interpolation, extrapolation and bisection. ") + (text . "\blankline") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Enter the function whose zero is to be determined ") + (text . "as a function of X, {\it f}: ") + (text . "\newline\tab{2} ") + (bcStrings (55 "exp(-X)-X" expression EM)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "\newline Lower bound of the interval {\it a}:") + (text . "\tab{32} \menuitemstyle{}\tab{34}") + (text . "Upper bound {\it b}: ") + (text . "\newline\tab{2} ") + (bcStrings (10 "0.0" a F)) + (text . "\tab{34} ") + (bcStrings (10 "1.0" b F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "\newline Absolute tolerance {\it eps}:") + (text . "\tab{32} \menuitemstyle{}\tab{34}") + (text . "Value tolerance {\it eta}:") + (text . "\newline\tab{2} ") + (bcStrings (10 "1.0e-5" eps F)) + (text . "\tab{34} ") + (bcStrings (10 "0.0" eta F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "\newline Ifail value:") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'c05adfGen) + htShowPage() + +c05adfGen htPage == + a := htpLabelInputString(htPage,'a) + b := htpLabelInputString(htPage,'b) + eps := htpLabelInputString(htPage,'eps) + eta := htpLabelInputString(htPage,'eta) + temp := READ_-FROM_-STRING(eps) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => 1 + -1 + temp1 := + temp > 0.0 => eps + '"1.0e-5" + expression := htpLabelInputString(htPage, 'expression) + prefix := STRCONC('"c05adf(",a,",",b,",",temp1,",",eta,",",STRINGIMAGE ifail) + linkGen STRCONC (prefix,",(",expression,")::ASP1(F))") + + +c05nbf() == + htInitPage('"C05NBF - Solution of system of nonlinear equations using function values only",nil) + htMakePage '( + (domainConditions + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXc05nbf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|c05nbf| '|NagRootFindingPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\newline ") + (text . "C05NBF finds a solution of a system of nonlinear equations ") + (text . "by a modification of the Powell hybrid method. ") + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the number of equations in the system {\it n}:") + (text . "\newline\tab{2} ") + (bcStrings (5 9 n PI)) + (text . "\newline ") + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Accuracy required {\it xtol}:") + (text . "\newline\tab{2} ") + -- should be sqrt(machine precision) + (bcStrings (10 "1.0e-9" xtol 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", 'c05nbfSolve) + htShowPage() + +c05nbfSolve htPage == + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + xtol := htpLabelInputString(htPage,'xtol) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + n = '9 => c05nbfDefaultSolve(htPage,ifail,xtol) + funcList := + "append"/[fa(i) for i in 1..n] where fa(i) == + prefix := ('"\newline {\em Function ") + prefix := STRCONC(prefix,STRINGIMAGE i,'":} \space{1}") + funct := STRCONC ('"X[",STRINGIMAGE i ,"] + 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}: \newline ") + middle := cons('text,middle) + vecList := + [fb(i) for i in 1..n] where fb(i) == + xnam := INTERN STRCONC ('"x",STRINGIMAGE i) + ['bcStrings,[4, -1.0, xnam, 'F]] + funcList := [:funcList,middle,:vecList] + equationPart := [ + '(domainConditions + (isDomain EM $EmptyMode) + (isDomain F (Float)) + (isDomain I (Integer))), + :funcList] + page := htInitPage("C05NBF - Solution of system of nonlinear equations using function values only", htpPropertyList htPage) + htSay '"\menuitemstyle{}\tab{2} " + htSay '"Enter the functions \htbitmap{fi} below in terms of X[1]...X[n]: " + htSay '"\newline " + htMakePage equationPart + htMakeDoneButton('"Continue",'c05nbfGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'xtol,xtol) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +c05nbfDefaultSolve (htPage,ifail,xtol) == + n := '9 + page := htInitPage("C05NBF - Solution of system of nonlinear equations 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 in terms of X[1]...X[n]; ") + (text . " \newline ") + (text . "\newline {\em Function 1:} \space{1}") + (bcStrings (42 "3*X[1] - 2*X[1]**2 - 2*X[2] + 1" n1 EM)) + (text . "\newline {\em Function 2:} \space{1}") + (bcStrings (42 "-X[1] + 3*X[2] - 2*X[2]**2 - 2*X[3] + 1" n2 EM)) + (text . "\newline {\em Function 3:} \space{1}") + (bcStrings (42 "-X[2] + 3*X[3] - 2*X[3]**2 - 2*X[4] + 1" n3 EM)) + (text . "\newline {\em Function 4:} \space{1}") + (bcStrings (42 "-X[3] + 3*X[4] - 2*X[4]**2 - 2*X[5] + 1" n4 EM)) + (text . "\newline {\em Function 5:} \space{1}") + (bcStrings (42 "-X[4] + 3*X[5] - 2*X[5]**2 - 2*X[6] + 1" n5 EM)) + (text . "\newline {\em Function 6:} \space{1}") + (bcStrings (42 "-X[5] + 3*X[6] - 2*X[6]**2 - 2*X[7] + 1" n6 EM)) + (text . "\newline {\em Function 7:} \space{1}") + (bcStrings (42 "-X[6] + 3*X[7] - 2*X[7]**2 - 2*X[8] + 1" n7 EM)) + (text . "\newline {\em Function 8:} \space{1}") + (bcStrings (42 "-X[7] + 3*X[8] - 2*X[8]**2 - 2*X[9] + 1" n8 EM)) + (text . "\newline {\em Function 9:} \space{1}") + (bcStrings (42 "-X[8] + 3*X[9] - 2*X[9]**2 + 1" n9 EM)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter initial guess of the solution vector {\it x}: \newline ") + (bcStrings (4 "-1.0" x1 F)) + (bcStrings (4 "-1.0" x2 F)) + (bcStrings (4 "-1.0" x3 F)) + (bcStrings (4 "-1.0" x4 F)) + (bcStrings (4 "-1.0" x5 F)) + (bcStrings (4 "-1.0" x6 F)) + (bcStrings (4 "-1.0" x7 F)) + (bcStrings (4 "-1.0" x8 F)) + (bcStrings (4 "-1.0" x9 F))) + htMakeDoneButton('"Continue",'c05nbfGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'xtol,xtol) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +c05nbfGen htPage == + n := htpProperty(htPage, 'n) + ifail := htpProperty(htPage,'ifail) + xtol := htpProperty(htPage,'xtol) + alist := htpInputAreaAlist htPage + y := alist + i := 1 + while y repeat + if i < (n+1) then + temp1 := STRCONC ((first y).1," ") + temp1list := [temp1,:temp1list] + else + temp2 := (first y).1 + temp2list := [temp2,:temp2list] + y := rest y + i := i + 1 + string1 := bcwords2liststring temp1list + string2 := bcwords2liststring temp2list + lwa := n*(3*n+13)/2 + prefix := STRCONC ("c05nbf(",STRINGIMAGE n,",",STRINGIMAGE lwa,",[",string1,"],") + middle := STRCONC (xtol,",",STRINGIMAGE ifail,",") + linkGen STRCONC (prefix,middle,"(",string2,"::Vector Expression(Float))::ASP6(FCN))") + +c05pbf() == + htInitPage('"C05PBF - Solution of system of nonlinear equations using first derivatives",nil) + htMakePage '( + (domainConditions + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXc05pbf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|c05pbf| '|NagRootFindingPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\newline ") + (text . "C05PBF finds a solution of a system of nonlinear equations ") + (text . "by a modification of the Powell hybrid method. ") + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the number of equations in the system {\it n}:") + (text . "\newline\tab{2} ") + (bcStrings (5 9 n PI)) + (text . "\newline ") + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Accuracy required {\it xtol}:") + (text . "\newline\tab{2} ") + -- should be sqrt(machine precision) + (bcStrings (10 "1.0e-9" xtol 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", 'c05pbfSolve) + htShowPage() + +c05pbfSolve htPage == + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + xtol := htpLabelInputString(htPage,'xtol) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + n = '9 => c05pbfDefaultSolve(htPage,ifail,xtol) + funcList := + "append"/[fa(i) for i in 1..n] where fa(i) == + prefix := ('"\newline {\em Function ") + prefix := STRCONC(prefix,STRINGIMAGE i,'":} \space{1}") + funct := STRCONC ('"X[",STRINGIMAGE i ,"] + 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}: \newline ") + middle := cons('text,middle) + vecList := + [fb(i) for i in 1..n] where fb(i) == + xnam := INTERN STRCONC ('"x",STRINGIMAGE i) + ['bcStrings,[4, -1.0, xnam, 'F]] + funcList := [:funcList,middle,:vecList] + equationPart := [ + '(domainConditions + (isDomain EM $EmptyMode) + (isDomain F (Float)) + (isDomain I (Integer))), + :funcList] + page := htInitPage('"C05PBF - Solution of system of nonlinear equations using first derivatives",htpPropertyList htPage) + htSay '"\menuitemstyle{}\tab{2} " + htSay '"Enter the functions \htbitmap{fi} below in terms of X[1]...X[n]: " + htSay '"\newline " + htMakePage equationPart + htMakeDoneButton('"Continue",'c05pbfGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'xtol,xtol) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +c05pbfDefaultSolve (htPage,ifail,xtol) == + n := '9 + page := htInitPage('"C05PBF - Solution of system of nonlinear equations using first 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 in terms of X[1]...X[n]: ") + (text . "\newline ") + (text . "\newline {\em Function 1:} \space{1}") + (bcStrings (42 "3*X[1] - 2*X[1]**2 - 2*X[2] + 1" n1 EM)) + (text . "\newline {\em Function 2:} \space{1}") + (bcStrings (42 "-X[1] + 3*X[2] - 2*X[2]**2 - 2*X[3] + 1" n2 EM)) + (text . "\newline {\em Function 3:} \space{1}") + (bcStrings (42 "-X[2] + 3*X[3] - 2*X[3]**2 - 2*X[4] + 1" n3 EM)) + (text . "\newline {\em Function 4:} \space{1}") + (bcStrings (42 "-X[3] + 3*X[4] - 2*X[4]**2 - 2*X[5] + 1" n4 EM)) + (text . "\newline {\em Function 5:} \space{1}") + (bcStrings (42 "-X[4] + 3*X[5] - 2*X[5]**2 - 2*X[6] + 1" n5 EM)) + (text . "\newline {\em Function 6:} \space{1}") + (bcStrings (42 "-X[5] + 3*X[6] - 2*X[6]**2 - 2*X[7] + 1" n6 EM)) + (text . "\newline {\em Function 7:} \space{1}") + (bcStrings (42 "-X[6] + 3*X[7] - 2*X[7]**2 - 2*X[8] + 1" n7 EM)) + (text . "\newline {\em Function 8:} \space{1}") + (bcStrings (42 "-X[7] + 3*X[8] - 2*X[8]**2 - 2*X[9] + 1" n8 EM)) + (text . "\newline {\em Function 9:} \space{1}") + (bcStrings (42 "-X[8] + 3*X[9] - 2*X[9]**2 + 1" n9 EM)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter initial guess of the solution vector {\it x}: \newline ") + (bcStrings (4 "-1.0" x1 F)) + (bcStrings (4 "-1.0" x2 F)) + (bcStrings (4 "-1.0" x3 F)) + (bcStrings (4 "-1.0" x4 F)) + (bcStrings (4 "-1.0" x5 F)) + (bcStrings (4 "-1.0" x6 F)) + (bcStrings (4 "-1.0" x7 F)) + (bcStrings (4 "-1.0" x8 F)) + (bcStrings (4 "-1.0" x9 F))) + htMakeDoneButton('"Continue",'c05pbfGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'xtol,xtol) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +c05pbfGen htPage == + n := htpProperty(htPage, 'n) + ifail := htpProperty(htPage,'ifail) + xtol := htpProperty(htPage,'xtol) + alist := htpInputAreaAlist htPage + y := alist + i := 1 + while y repeat + if i < (n+1) then + temp1 := STRCONC ((first y).1," ") + temp1list := [temp1,:temp1list] + else + temp2 := (first y).1 + temp2list := [temp2,:temp2list] + y := rest y + i := i + 1 + string1 := bcwords2liststring temp1list + string2 := bcwords2liststring temp2list + lwa := n*(n+13)/2 + prefix := STRCONC("c05pbf(",STRINGIMAGE n,",",STRINGIMAGE n) + middle := STRCONC(",",STRINGIMAGE lwa,",[",string1,"],") + middle := STRCONC (middle,xtol,",",STRINGIMAGE ifail,",") + linkGen STRCONC (prefix,middle,"(",string2,"::Vector Expression(Float))::ASP35(FCN))") + diff --git a/src/interp/nag-c05.boot.pamphlet b/src/interp/nag-c05.boot.pamphlet deleted file mode 100644 index 5e072489..00000000 --- a/src/interp/nag-c05.boot.pamphlet +++ /dev/null @@ -1,426 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp nag-c05.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. - -@ -<<*>>= -<> - -)package "BOOT" - -c05adf() == - htInitPage('"C05ADF - Zero of continuous function in given interval, Bus and Dekker algorithm",nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXc05adf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|c05adf| '|NagRootFindingPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "C05ADF locates a zero of a continuous function in a ") - (text . "interval by a combination of the methods of linear ") - (text . "interpolation, extrapolation and bisection. ") - (text . "\blankline") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Enter the function whose zero is to be determined ") - (text . "as a function of X, {\it f}: ") - (text . "\newline\tab{2} ") - (bcStrings (55 "exp(-X)-X" expression EM)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "\newline Lower bound of the interval {\it a}:") - (text . "\tab{32} \menuitemstyle{}\tab{34}") - (text . "Upper bound {\it b}: ") - (text . "\newline\tab{2} ") - (bcStrings (10 "0.0" a F)) - (text . "\tab{34} ") - (bcStrings (10 "1.0" b F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "\newline Absolute tolerance {\it eps}:") - (text . "\tab{32} \menuitemstyle{}\tab{34}") - (text . "Value tolerance {\it eta}:") - (text . "\newline\tab{2} ") - (bcStrings (10 "1.0e-5" eps F)) - (text . "\tab{34} ") - (bcStrings (10 "0.0" eta F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "\newline Ifail value:") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'c05adfGen) - htShowPage() - -c05adfGen htPage == - a := htpLabelInputString(htPage,'a) - b := htpLabelInputString(htPage,'b) - eps := htpLabelInputString(htPage,'eps) - eta := htpLabelInputString(htPage,'eta) - temp := READ_-FROM_-STRING(eps) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => 1 - -1 - temp1 := - temp > 0.0 => eps - '"1.0e-5" - expression := htpLabelInputString(htPage, 'expression) - prefix := STRCONC('"c05adf(",a,",",b,",",temp1,",",eta,",",STRINGIMAGE ifail) - linkGen STRCONC (prefix,",(",expression,")::ASP1(F))") - - -c05nbf() == - htInitPage('"C05NBF - Solution of system of nonlinear equations using function values only",nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXc05nbf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|c05nbf| '|NagRootFindingPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "C05NBF finds a solution of a system of nonlinear equations ") - (text . "by a modification of the Powell hybrid method. ") - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the number of equations in the system {\it n}:") - (text . "\newline\tab{2} ") - (bcStrings (5 9 n PI)) - (text . "\newline ") - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Accuracy required {\it xtol}:") - (text . "\newline\tab{2} ") - -- should be sqrt(machine precision) - (bcStrings (10 "1.0e-9" xtol 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", 'c05nbfSolve) - htShowPage() - -c05nbfSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - xtol := htpLabelInputString(htPage,'xtol) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - n = '9 => c05nbfDefaultSolve(htPage,ifail,xtol) - funcList := - "append"/[fa(i) for i in 1..n] where fa(i) == - prefix := ('"\newline {\em Function ") - prefix := STRCONC(prefix,STRINGIMAGE i,'":} \space{1}") - funct := STRCONC ('"X[",STRINGIMAGE i ,"] + 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}: \newline ") - middle := cons('text,middle) - vecList := - [fb(i) for i in 1..n] where fb(i) == - xnam := INTERN STRCONC ('"x",STRINGIMAGE i) - ['bcStrings,[4, -1.0, xnam, 'F]] - funcList := [:funcList,middle,:vecList] - equationPart := [ - '(domainConditions - (isDomain EM $EmptyMode) - (isDomain F (Float)) - (isDomain I (Integer))), - :funcList] - page := htInitPage("C05NBF - Solution of system of nonlinear equations using function values only", htpPropertyList htPage) - htSay '"\menuitemstyle{}\tab{2} " - htSay '"Enter the functions \htbitmap{fi} below in terms of X[1]...X[n]: " - htSay '"\newline " - htMakePage equationPart - htMakeDoneButton('"Continue",'c05nbfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'xtol,xtol) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -c05nbfDefaultSolve (htPage,ifail,xtol) == - n := '9 - page := htInitPage("C05NBF - Solution of system of nonlinear equations 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 in terms of X[1]...X[n]; ") - (text . " \newline ") - (text . "\newline {\em Function 1:} \space{1}") - (bcStrings (42 "3*X[1] - 2*X[1]**2 - 2*X[2] + 1" n1 EM)) - (text . "\newline {\em Function 2:} \space{1}") - (bcStrings (42 "-X[1] + 3*X[2] - 2*X[2]**2 - 2*X[3] + 1" n2 EM)) - (text . "\newline {\em Function 3:} \space{1}") - (bcStrings (42 "-X[2] + 3*X[3] - 2*X[3]**2 - 2*X[4] + 1" n3 EM)) - (text . "\newline {\em Function 4:} \space{1}") - (bcStrings (42 "-X[3] + 3*X[4] - 2*X[4]**2 - 2*X[5] + 1" n4 EM)) - (text . "\newline {\em Function 5:} \space{1}") - (bcStrings (42 "-X[4] + 3*X[5] - 2*X[5]**2 - 2*X[6] + 1" n5 EM)) - (text . "\newline {\em Function 6:} \space{1}") - (bcStrings (42 "-X[5] + 3*X[6] - 2*X[6]**2 - 2*X[7] + 1" n6 EM)) - (text . "\newline {\em Function 7:} \space{1}") - (bcStrings (42 "-X[6] + 3*X[7] - 2*X[7]**2 - 2*X[8] + 1" n7 EM)) - (text . "\newline {\em Function 8:} \space{1}") - (bcStrings (42 "-X[7] + 3*X[8] - 2*X[8]**2 - 2*X[9] + 1" n8 EM)) - (text . "\newline {\em Function 9:} \space{1}") - (bcStrings (42 "-X[8] + 3*X[9] - 2*X[9]**2 + 1" n9 EM)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter initial guess of the solution vector {\it x}: \newline ") - (bcStrings (4 "-1.0" x1 F)) - (bcStrings (4 "-1.0" x2 F)) - (bcStrings (4 "-1.0" x3 F)) - (bcStrings (4 "-1.0" x4 F)) - (bcStrings (4 "-1.0" x5 F)) - (bcStrings (4 "-1.0" x6 F)) - (bcStrings (4 "-1.0" x7 F)) - (bcStrings (4 "-1.0" x8 F)) - (bcStrings (4 "-1.0" x9 F))) - htMakeDoneButton('"Continue",'c05nbfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'xtol,xtol) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -c05nbfGen htPage == - n := htpProperty(htPage, 'n) - ifail := htpProperty(htPage,'ifail) - xtol := htpProperty(htPage,'xtol) - alist := htpInputAreaAlist htPage - y := alist - i := 1 - while y repeat - if i < (n+1) then - temp1 := STRCONC ((first y).1," ") - temp1list := [temp1,:temp1list] - else - temp2 := (first y).1 - temp2list := [temp2,:temp2list] - y := rest y - i := i + 1 - string1 := bcwords2liststring temp1list - string2 := bcwords2liststring temp2list - lwa := n*(3*n+13)/2 - prefix := STRCONC ("c05nbf(",STRINGIMAGE n,",",STRINGIMAGE lwa,",[",string1,"],") - middle := STRCONC (xtol,",",STRINGIMAGE ifail,",") - linkGen STRCONC (prefix,middle,"(",string2,"::Vector Expression(Float))::ASP6(FCN))") - -c05pbf() == - htInitPage('"C05PBF - Solution of system of nonlinear equations using first derivatives",nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXc05pbf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|c05pbf| '|NagRootFindingPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "C05PBF finds a solution of a system of nonlinear equations ") - (text . "by a modification of the Powell hybrid method. ") - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the number of equations in the system {\it n}:") - (text . "\newline\tab{2} ") - (bcStrings (5 9 n PI)) - (text . "\newline ") - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Accuracy required {\it xtol}:") - (text . "\newline\tab{2} ") - -- should be sqrt(machine precision) - (bcStrings (10 "1.0e-9" xtol 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", 'c05pbfSolve) - htShowPage() - -c05pbfSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - xtol := htpLabelInputString(htPage,'xtol) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - n = '9 => c05pbfDefaultSolve(htPage,ifail,xtol) - funcList := - "append"/[fa(i) for i in 1..n] where fa(i) == - prefix := ('"\newline {\em Function ") - prefix := STRCONC(prefix,STRINGIMAGE i,'":} \space{1}") - funct := STRCONC ('"X[",STRINGIMAGE i ,"] + 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}: \newline ") - middle := cons('text,middle) - vecList := - [fb(i) for i in 1..n] where fb(i) == - xnam := INTERN STRCONC ('"x",STRINGIMAGE i) - ['bcStrings,[4, -1.0, xnam, 'F]] - funcList := [:funcList,middle,:vecList] - equationPart := [ - '(domainConditions - (isDomain EM $EmptyMode) - (isDomain F (Float)) - (isDomain I (Integer))), - :funcList] - page := htInitPage('"C05PBF - Solution of system of nonlinear equations using first derivatives",htpPropertyList htPage) - htSay '"\menuitemstyle{}\tab{2} " - htSay '"Enter the functions \htbitmap{fi} below in terms of X[1]...X[n]: " - htSay '"\newline " - htMakePage equationPart - htMakeDoneButton('"Continue",'c05pbfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'xtol,xtol) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -c05pbfDefaultSolve (htPage,ifail,xtol) == - n := '9 - page := htInitPage('"C05PBF - Solution of system of nonlinear equations using first 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 in terms of X[1]...X[n]: ") - (text . "\newline ") - (text . "\newline {\em Function 1:} \space{1}") - (bcStrings (42 "3*X[1] - 2*X[1]**2 - 2*X[2] + 1" n1 EM)) - (text . "\newline {\em Function 2:} \space{1}") - (bcStrings (42 "-X[1] + 3*X[2] - 2*X[2]**2 - 2*X[3] + 1" n2 EM)) - (text . "\newline {\em Function 3:} \space{1}") - (bcStrings (42 "-X[2] + 3*X[3] - 2*X[3]**2 - 2*X[4] + 1" n3 EM)) - (text . "\newline {\em Function 4:} \space{1}") - (bcStrings (42 "-X[3] + 3*X[4] - 2*X[4]**2 - 2*X[5] + 1" n4 EM)) - (text . "\newline {\em Function 5:} \space{1}") - (bcStrings (42 "-X[4] + 3*X[5] - 2*X[5]**2 - 2*X[6] + 1" n5 EM)) - (text . "\newline {\em Function 6:} \space{1}") - (bcStrings (42 "-X[5] + 3*X[6] - 2*X[6]**2 - 2*X[7] + 1" n6 EM)) - (text . "\newline {\em Function 7:} \space{1}") - (bcStrings (42 "-X[6] + 3*X[7] - 2*X[7]**2 - 2*X[8] + 1" n7 EM)) - (text . "\newline {\em Function 8:} \space{1}") - (bcStrings (42 "-X[7] + 3*X[8] - 2*X[8]**2 - 2*X[9] + 1" n8 EM)) - (text . "\newline {\em Function 9:} \space{1}") - (bcStrings (42 "-X[8] + 3*X[9] - 2*X[9]**2 + 1" n9 EM)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter initial guess of the solution vector {\it x}: \newline ") - (bcStrings (4 "-1.0" x1 F)) - (bcStrings (4 "-1.0" x2 F)) - (bcStrings (4 "-1.0" x3 F)) - (bcStrings (4 "-1.0" x4 F)) - (bcStrings (4 "-1.0" x5 F)) - (bcStrings (4 "-1.0" x6 F)) - (bcStrings (4 "-1.0" x7 F)) - (bcStrings (4 "-1.0" x8 F)) - (bcStrings (4 "-1.0" x9 F))) - htMakeDoneButton('"Continue",'c05pbfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'xtol,xtol) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -c05pbfGen htPage == - n := htpProperty(htPage, 'n) - ifail := htpProperty(htPage,'ifail) - xtol := htpProperty(htPage,'xtol) - alist := htpInputAreaAlist htPage - y := alist - i := 1 - while y repeat - if i < (n+1) then - temp1 := STRCONC ((first y).1," ") - temp1list := [temp1,:temp1list] - else - temp2 := (first y).1 - temp2list := [temp2,:temp2list] - y := rest y - i := i + 1 - string1 := bcwords2liststring temp1list - string2 := bcwords2liststring temp2list - lwa := n*(n+13)/2 - prefix := STRCONC("c05pbf(",STRINGIMAGE n,",",STRINGIMAGE n) - middle := STRCONC(",",STRINGIMAGE lwa,",[",string1,"],") - middle := STRCONC (middle,xtol,",",STRINGIMAGE ifail,",") - linkGen STRCONC (prefix,middle,"(",string2,"::Vector Expression(Float))::ASP35(FCN))") - -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/nag-c06.boot b/src/interp/nag-c06.boot new file mode 100644 index 00000000..f5733a6a --- /dev/null +++ b/src/interp/nag-c06.boot @@ -0,0 +1,1834 @@ +-- 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. + + +)package "BOOT" + +c06eaf() == + htInitPage('"C06EAF - Single 1-D real discrete Fourier transform ",nil) + htMakePage '( + (domainConditions + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXc06eaf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|c06eaf| '|NagSeriesSummationPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "Calculates the discrete Fourier transform of the sequence ") + (text . "of real data values \space{1} \inputbitmap{\htbmdir{}/xj.bitmap}, for ") + (text . "j = 0,1,...,n-1. ") + (text . "\newline ") + (text . "\blankline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "Enter the number of data values: ") + (text . "\newline\tab{2} ") + (bcStrings (5 7 n PI)) + (text . "\blankline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "Ifail value:") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'c06eafSolve) + htShowPage() + +c06eafSolve htPage == + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + n = '7 => c06eafDefaultSolve(htPage,ifail) + labelList := + "append"/[f(i) for i in 1..n] where f(i) == + prefix := ('"\newline \tab{15} ") + rnam := INTERN STRCONC ('"r",STRINGIMAGE i) + [['text,:prefix],['bcStrings,[10, 0.0, rnam, 'F]]] + equationPart := [ + '(domainConditions + (isDomain F (Float))), + :labelList] + page := htInitPage("C06EAF - Single 1-D real discrete Fourier transform ", htpPropertyList htPage) + htSay '"\menuitemstyle{} \tab{2} " + htSay '"Enter the sequence to be transformed: " + htMakePage equationPart + htSay '"\blankline " + htSay '"Note : On exit, the transformed sequence is stored " + htSay '"in Hermitian form " + htSay '"\blankline " + htMakeDoneButton('"Continue",'c06eafGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +c06eafDefaultSolve (htPage, ifail) == + n := '7 + page := htInitPage('"C06EAF - Single 1-D real discrete Fourier transform ",nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Enter the sequence to be transformed: ") + (text . "\newline \tab{15} ") + (bcStrings (10 "0.34907" r1 F)) + (text . "\newline \tab{15} ") + (bcStrings (10 "0.54890" r2 F)) + (text . "\newline \tab{15} ") + (bcStrings (10 "0.74776" r3 F)) + (text . "\newline \tab{15} ") + (bcStrings (10 "0.94459" r4 F)) + (text . "\newline \tab{15} ") + (bcStrings (10 "1.13850" r5 F)) + (text . "\newline \tab{15} ") + (bcStrings (10 "1.32850" r6 F)) + (text . "\newline \tab{15} ") + (bcStrings (10 "1.51370" r7 F)) + (text . "\blankline ") + (text . "Note : On exit, the transformed sequence is stored ") + (text . "in Hermitian form ") + (text . "\blankline ")) + htMakeDoneButton('"Continue",'c06eafGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +c06eafGen htPage == + n := htpProperty(htPage,'n) + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + while y repeat + left := STRCONC((first y).1," ") + y := rest y + reallist := [left,:reallist] + realstring := bcwords2liststring reallist + linkGen STRCONC ('"c06eaf(",STRINGIMAGE n,",[",realstring,"],",STRINGIMAGE ifail,")") + +c06ebf() == + htInitPage('"C06EBF - Single 1-D Hermitian discrete Fourier transform ",nil) + htMakePage '( + (domainConditions + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXc06ebf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|c06ebf| '|NagSeriesSummationPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "Calculates the discrete Fourier transform of a Hermitian ") + (text . "sequence of complex data values. ") + (text . "\newline ") + (text . "\blankline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "Enter the number of data values: ") + (text . "\newline \tab{2}") + (bcStrings (5 7 n PI)) + (text . "\blankline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "Ifail value: ") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'c06ebfSolve) + htShowPage() + +c06ebfSolve htPage == + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + n = '7 => c06ebfDefaultSolve(htPage,ifail) + labelList := + "append"/[f(i) for i in 1..n] where f(i) == + prefix := ('"\newline \tab{15} ") + rnam := INTERN STRCONC ('"r",STRINGIMAGE i) + [['text,:prefix],['bcStrings,[10, 0.0, rnam, 'F]]] + equationPart := [ + '(domainConditions + (isDomain F (Float))), + :labelList] + page := htInitPage("C06EBF - Single 1-D real discrete Fourier transform ", htpPropertyList htPage) + htSay '"\menuitemstyle{} \tab{2} " + htSay '"Enter the sequence to be transformed, stored in Hermitian form: " + htMakePage equationPart + htSay '"\blankline " + htSay '"Note : On exit, the components of the discrete Fourier transform " + htSay '"\blankline " + htMakeDoneButton('"Continue",'c06ebfGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +c06ebfDefaultSolve (htPage, ifail) == + n := '7 + page := htInitPage('"C06EBF - Single 1-D Hermitian discrete Fourier transform ",nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Enter the sequence to be transformed, stored in Hermitian form: ") + (text . "\newline \tab{15} ") + (bcStrings (10 "0.34907" r1 F)) + (text . "\newline \tab{15} ") + (bcStrings (10 "0.54890" r2 F)) + (text . "\newline \tab{15} ") + (bcStrings (10 "0.74776" r3 F)) + (text . "\newline \tab{15} ") + (bcStrings (10 "0.94459" r4 F)) + (text . "\newline \tab{15} ") + (bcStrings (10 "1.13850" r5 F)) + (text . "\newline \tab{15} ") + (bcStrings (10 "1.32850" r6 F)) + (text . "\newline \tab{15} ") + (bcStrings (10 "1.51370" r7 F)) + (text . "\blankline ") + (text . "Note : On exit, the components of the discrete Fourier transform") + (text . "\blankline ")) + htMakeDoneButton('"Continue",'c06ebfGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +c06ebfGen htPage == + n := htpProperty(htPage,'n) + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + while y repeat + left := STRCONC((first y).1," ") + y := rest y + reallist := [left,:reallist] + realstring := bcwords2liststring reallist + linkGen STRCONC ('"c06ebf(",STRINGIMAGE n,",[",realstring,"],",STRINGIMAGE ifail,")") + + +c06ecf() == + htInitPage('"C06ECF - Single 1-D complex discrete Fourier transform ",nil) + htMakePage '( + (domainConditions + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXc06ecf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|c06ecf| '|NagSeriesSummationPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "Calculates the discrete Fourier transform of a complex sequence.") + (text . "\newline ") + (text . "\blankline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "Enter the number of data values: ") + (text . "\newline\tab{2} ") + (bcStrings (5 7 n PI)) + (text . "\blankline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "Ifail value:") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'c06ecfSolve) + htShowPage() + + +c06ecfSolve htPage == + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + n = '7 => c06ecfDefaultSolve(htPage,ifail) + labelList := + "append"/[f(i) for i in 1..n] where f(i) == + prefix := ('"\newline \tab{2} ") + post := ('"\tab{32} ") + xnam := INTERN STRCONC ('"x",STRINGIMAGE i) + ynam := INTERN STRCONC ('"y",STRINGIMAGE i) + [['text,:prefix],['bcStrings,[10, 0.0, xnam, 'F]], + ['text,:post],['bcStrings,[10, 0.0, ynam, 'F]]] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :labelList] + page := htInitPage("C06ECF - Single 1-D complex discrete Fourier transform ",htpPropertyList htPage) + htSay '"\menuitemstyle{}\tab{2} Real parts of sequence: \tab{30} " + htSay '"\menuitemstyle{}\tab{32} Imaginary parts: " + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'c06ecfGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +c06ecfDefaultSolve (htPage, ifail) == + n := '7 + page := htInitPage('"C06ECF - Single 1-D complex discrete Fourier transform ",htpPropertyList htPage) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Real parts of sequence: \tab{30} ") + (text . "\menuitemstyle{}\tab{32} Imaginary parts: ") + (text . "\newline \tab{2}") + (bcStrings (10 "0.34907" x1 F)) + (text . "\tab{32} ") + (bcStrings (10 "-0.37168" y1 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.54890" x2 F)) + (text . "\tab{32} ") + (bcStrings (10 "-0.35669" y2 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.74776" x3 F)) + (text . "\tab{32} ") + (bcStrings (10 "-0.31175" y3 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.94459" x4 F)) + (text . "\tab{32} ") + (bcStrings (10 "-0.23702" y4 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "1.13850" x5 F)) + (text . "\tab{32} ") + (bcStrings (10 "-0.13274" y5 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "1.32850" x6 F)) + (text . "\tab{32} ") + (bcStrings (10 "0.00074" y6 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "1.51370" x7 F)) + (text . "\tab{32} ") + (bcStrings (10 "0.16298" y7 F)) + (text . "\blankline")) + htMakeDoneButton('"Continue",'c06ecfGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +c06ecfGen htPage == + n := htpProperty(htPage,'n) + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + while y repeat + right := STRCONC ((first y).1," ") + y := rest y + left := STRCONC ((first y).1," ") + y := rest y + reallist := [left,:reallist] + imaglist := [right,:imaglist] + realstring := bcwords2liststring reallist + imagstring := bcwords2liststring imaglist + linkGen STRCONC ('"c06ecf(",STRINGIMAGE n,",[",realstring,"],[",imagstring,"],", STRINGIMAGE ifail,")") + + +c06ekf() == + htInitPage('"C06EKF - Circular convolution or correlation of two real vectors",nil) + htMakePage '( + (domainConditions + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXc06ekf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|c06ekf| '|NagSeriesSummationPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "Calculates the circular convolution or correlation of two real ") + (text . "vectors of period {\em n} ") + (text . "\newline ") + (text . "\blankline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "Enter the number of data values: ") + (text . "\newline\tab{2} ") + (bcStrings (5 9 n PI)) + (text . "\blankline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "Choose the computation to be performed:") + (radioButtons job + ("" " Convolution" conv) + ("" " Correlation" corr)) + (text . "\blankline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "Ifail value:") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'c06ekfSolve) + htShowPage() + + +c06ekfSolve htPage == + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + type := htpButtonValue(htPage,'job) + job := + type = 'conv => '1 + '2 + n = '9 => c06ekfDefaultSolve(htPage,job,ifail) + labelList := + "append"/[f(i) for i in 1..n] where f(i) == + prefix := ('"\newline \tab{2} ") + post := ('"\tab{34} ") + xnam := INTERN STRCONC ('"x",STRINGIMAGE i) + ynam := INTERN STRCONC ('"y",STRINGIMAGE i) + [['text,:prefix],['bcStrings,[10, 0.0, xnam, 'F]], + ['text,:post],['bcStrings,[10, 0.0, ynam, 'F]]] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :labelList] + page := htInitPage("C06EKF - Single 1-D complex discrete Fourier transform ",htpPropertyList htPage) + htSay '"\menuitemstyle{}\tab{2} Elements of period of vector {\em x}: " + htSay '"\tab{31} " + htSay '"\menuitemstyle{}\tab{34} Elements of period of vector {\em y}:" + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'c06ekfGen) + htpSetProperty(page,'job,job) + htpSetProperty(page,'n,n) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +c06ekfDefaultSolve (htPage, job, ifail) == + n := '9 + page := htInitPage('"C06EKF - Circular convolution or correlation of two real vectors ",htpPropertyList htPage) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Elements of period of vector {\em x}: \tab{32} ") + (text . "\menuitemstyle{}\tab{34} Elements of period of vector {\em y}: ") + (text . "\newline \tab{2}") + (bcStrings (10 "1.00" x1 F)) + (text . "\tab{34} ") + (bcStrings (10 "0.50" y1 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "1.00" x2 F)) + (text . "\tab{34} ") + (bcStrings (10 "0.50" y2 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "1.00" x3 F)) + (text . "\tab{34} ") + (bcStrings (10 "0.50" y3 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "1.00" x4 F)) + (text . "\tab{34} ") + (bcStrings (10 "0.50" y4 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "1.00" x5 F)) + (text . "\tab{34} ") + (bcStrings (10 "0.00" y5 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.00" x6 F)) + (text . "\tab{34} ") + (bcStrings (10 "0.00" y6 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.00" x7 F)) + (text . "\tab{34} ") + (bcStrings (10 "0.00" y7 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.00" x8 F)) + (text . "\tab{34} ") + (bcStrings (10 "0.00" y8 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.00" x9 F)) + (text . "\tab{34} ") + (bcStrings (10 "0.00" y9 F)) + (text . "\blankline")) + htMakeDoneButton('"Continue",'c06ekfGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'job,job) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +c06ekfGen htPage == + n := htpProperty(htPage,'n) + ifail := htpProperty(htPage,'ifail) + job := htpProperty(htPage,'job) + alist := htpInputAreaAlist htPage + y := alist + while y repeat + right := STRCONC ((first y).1," ") + y := rest y + left := STRCONC ((first y).1," ") + y := rest y + reallist := [left,:reallist] + imaglist := [right,:imaglist] + realstring := bcwords2liststring reallist + imagstring := bcwords2liststring imaglist + linkGen STRCONC ('"c06ekf(",STRINGIMAGE job,",",STRINGIMAGE n,",[",realstring,"],[",imagstring,"],", STRINGIMAGE ifail,")") + +c06fpf() == + htInitPage('"C06FPF - Multiple 1-D real discrete Fourier transform ",nil) + htMakePage '( + (domainConditions + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXc06fpf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|c06fpf| '|NagSeriesSummationPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "Computes the discrete Fourier transforms of {\it m} real ") + (text . "sequences, each containing {\it n} data values.") + (text . "\blankline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "Enter the number of sequences to be transformed {\it m}: ") + (text . "\newline \tab{2} ") + (bcStrings (5 3 m PI)) + (text . "\blankline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "Enter the number of data values {\it n}: ") + (text . "\newline\tab{2} ") + (bcStrings (5 6 n PI)) + (text . "\blankline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "Type of call:") + (radioButtons init + ("" " Initial" i) + ("" " Subsequent" s) + ("" " Restart" r)) + (text . "\blankline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "Ifail value:") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'c06fpfSolve) + htShowPage() + +c06fpfSolve htPage == + m := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) + objValUnwrap htpLabelSpadValue(htPage, 'm) + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + call := htpButtonValue(htPage,'init) + init := + call = 'i => '"i" + call = 's => '"s" + '"r" + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + (n = '6 and m = '3) => c06fpfDefaultSolve(htPage,init,ifail) + matList := + "append"/[f(i,m) for i in 1..n] where f(i,n) == + labelList := + "append"/[g(i,j) for j in 1..n] where g(i,j) == + xnam := INTERN STRCONC ('"r",STRINGIMAGE i, STRINGIMAGE j) + [['bcStrings,[6, 0.0, xnam, 'F]]] + prefix := ('"\newline \tab{2} ") + labelList := [['text,:prefix],:labelList] + trigList := + "append"/[h(k) for k in 1..(2*n)] where h(k) == + prefix := ('"\newline \tab{2} ") + trignam := INTERN STRCONC ('"t",STRINGIMAGE k) + [['text,:prefix],['bcStrings,[6, "0.0", trignam, 'F]]] + prefix := ('"\blankline \menuitemstyle{} \tab{2} Trigonometric coefficients ") + prefix := STRCONC(prefix,"(not required if initial call) {\it TRIG}: ") + prefix := STRCONC(prefix,"\newline \tab{2} ") + trigList := [['text,:prefix],:trigList] + equationPart := [ + '(domainConditions + (isDomain F (Float))), + :matList,:trigList] + page := htInitPage("C06FPF - Multiple 1-D real discrete Fourier transform ", htpPropertyList htPage) + htSay '"\menuitemstyle{} \tab{2} " + htSay '"Enter each sequence to be transformed, {\it x}. " + htSay '"(Each column to contain a sequence.) " + htMakePage equationPart + htMakeDoneButton('"Continue",'c06fpfGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'m,m) + htpSetProperty(page,'init,init) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +c06fpfDefaultSolve (htPage, init,ifail) == + n := '6 + m := '3 + page := htInitPage('"C06FPF - Multiple 1-D real discrete Fourier transform ",nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Enter each sequence to be transformed, {\it x}. ") + (text . "(Each column to contain a sequence.) ") + (text . "\newline \tab{2} ") + (bcStrings (6 "0.3854" x11 F)) + (bcStrings (6 "0.5417" x21 F)) + (bcStrings (6 "0.9172" x31 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.6772" x12 F)) + (bcStrings (6 "0.2983" x22 F)) + (bcStrings (6 "0.0644" x32 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.1138" x13 F)) + (bcStrings (6 "0.1181" x23 F)) + (bcStrings (6 "0.6037" x33 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.6751" x14 F)) + (bcStrings (6 "0.7255" x24 F)) + (bcStrings (6 "0.6430" x34 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.6362" x15 F)) + (bcStrings (6 "0.8638" x25 F)) + (bcStrings (6 "0.0428" x35 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.1424" x16 F)) + (bcStrings (6 "0.8723" x26 F)) + (bcStrings (6 "0.4815" x36 F)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Trignometric coefficients (not required if initial call) ") + (text . "{\it TRIG}: \newline \tab{2} ") + (bcStrings (6 "0.0" t1 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" t2 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" t3 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" t4 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" t5 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" t6 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" t7 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" t8 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" t9 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" t10 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" t11 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" t12 F)) + (text . "\blankline ")) + htMakeDoneButton('"Continue",'c06fpfGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'m,m) + htpSetProperty(page,'init,init) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +c06fpfGen htPage == + n := htpProperty(htPage,'n) + m := htpProperty(htPage,'m) + init := htpProperty(htPage,'init) + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + for i in 1..(2*n) repeat + left := STRCONC((first y).1," ") + y := rest y + triglist := [left,:triglist] + trigstring := bcwords2liststring triglist + while y repeat + left := STRCONC((first y).1," ") + y := rest y + xlist := [left,:xlist] + xstring := bcwords2liststring xlist + prefix := STRCONC ('"c06fpf(",STRINGIMAGE m,", ",STRINGIMAGE n,", _"") + prefix := STRCONC(prefix,init,"_",[",xstring,"],[",trigstring,"],") + linkGen STRCONC(prefix,STRINGIMAGE ifail,")") + + +c06fqf() == + htInitPage('"C06FQF - Multiple 1-D Hermitian discrete Fourier transform ",nil) + htMakePage '( + (domainConditions + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXc06fqf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|c06fqf| '|NagSeriesSummationPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "Computes the discrete Fourier transforms of {\it m} real ") + (text . "sequences, each containing {\it n} data values.") + (text . "\blankline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "Enter the number of sequences to be transformed {\it m}: ") + (text . "\newline \tab{2} ") + (bcStrings (5 3 m PI)) + (text . "\blankline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "Enter the number of data values {\it n}: ") + (text . "\newline\tab{2} ") + (bcStrings (5 6 n PI)) + (text . "\blankline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "Type of call:") + (radioButtons init + ("" " Initial" i) + ("" " Subsequent" s) + ("" " Restart" r)) + (text . "\blankline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "Ifail value:") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'c06fqfSolve) + htShowPage() + +c06fqfSolve htPage == + m := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) + objValUnwrap htpLabelSpadValue(htPage, 'm) + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + call := htpButtonValue(htPage,'init) + init := + call = 'i => '"i" + call = 's => '"s" + '"r" + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + (n = '6 and m = '3) => c06fqfDefaultSolve(htPage,init,ifail) + matList := + "append"/[f(i,m) for i in 1..n] where f(i,n) == + labelList := + "append"/[g(i,j) for j in 1..n] where g(i,j) == + xnam := INTERN STRCONC ('"r",STRINGIMAGE i, STRINGIMAGE j) + [['bcStrings,[6, 0.0, xnam, 'F]]] + prefix := ('"\newline \tab{2} ") + labelList := [['text,:prefix],:labelList] + trigList := + "append"/[h(k) for k in 1..(2*n)] where h(k) == + prefix := ("\newline \tab{2} ") + trignam := INTERN STRCONC ('"t",STRINGIMAGE k) + [['text,:prefix],['bcStrings,[6, "0.0", trignam, 'F]]] + prefix := ('"\blankline \menuitemstyle{} \tab{2} Trignometric coefficients ") + prefix := STRCONC(prefix,"(not required if initial call) {\it TRIG}: ") + prefix := STRCONC(prefix,"\newline \tab{2} ") + trigList := [['text,:prefix],:trigList] + equationPart := [ + '(domainConditions + (isDomain F (Float))), + :matList,:trigList] + page := htInitPage("C06FQF - Multiple 1-D Hermitian discrete Fourier transform ", htpPropertyList htPage) + htSay '"\menuitemstyle{} \tab{2} " + htSay '"Enter each sequence to be transformed, {\it x}. " + htSay '"(Each column to contain a sequence.) " + htMakePage equationPart + htMakeDoneButton('"Continue",'c06fqfGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'m,m) + htpSetProperty(page,'init,init) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +c06fqfDefaultSolve (htPage, init,ifail) == + n := '6 + m := '3 + page := htInitPage('"C06FQF - Multiple 1-D Hermitian discrete Fourier transform ",nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Enter each sequence to be transformed, {\it x}. ") + (text . "(Each column to contain a sequence.) ") + (text . "\newline \tab{2} ") + (bcStrings (6 "0.3854" x11 F)) + (bcStrings (6 "0.5417" x21 F)) + (bcStrings (6 "0.9172" x31 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.6772" x12 F)) + (bcStrings (6 "0.2983" x22 F)) + (bcStrings (6 "0.0644" x32 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.1138" x13 F)) + (bcStrings (6 "0.1181" x23 F)) + (bcStrings (6 "0.6037" x33 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.6751" x14 F)) + (bcStrings (6 "0.7255" x24 F)) + (bcStrings (6 "0.6430" x34 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.6362" x15 F)) + (bcStrings (6 "0.8638" x25 F)) + (bcStrings (6 "0.0428" x35 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.1424" x16 F)) + (bcStrings (6 "0.8723" x26 F)) + (bcStrings (6 "0.4815" x36 F)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Trignometric coefficients (not required if initial call) ") + (text . "{\it TRIG}: \newline \tab{2} ") + (bcStrings (6 "0.0" t1 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" t2 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" t3 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" t4 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" t5 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" t6 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" t7 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" t8 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" t9 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" t10 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" t11 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" t12 F)) + (text . "\blankline ")) + htMakeDoneButton('"Continue",'c06fqfGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'m,m) + htpSetProperty(page,'init,init) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +c06fqfGen htPage == + n := htpProperty(htPage,'n) + m := htpProperty(htPage,'m) + init := htpProperty(htPage,'init) + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + for i in 1..(2*n) repeat + left := STRCONC((first y).1," ") + y := rest y + triglist := [left,:triglist] + trigstring := bcwords2liststring triglist + while y repeat + left := STRCONC((first y).1," ") + y := rest y + xlist := [left,:xlist] + xstring := bcwords2liststring xlist + prefix := STRCONC ('"c06fqf(",STRINGIMAGE m,", ",STRINGIMAGE n,", _"") + prefix := STRCONC(prefix,init,"_",[",xstring,"],[",trigstring,"],") + linkGen STRCONC(prefix,STRINGIMAGE ifail,")") + + +c06frf() == + htInitPage('"C06FRF - Multiple 1-D complex discrete Fourier transform ",nil) + htMakePage '( + (domainConditions + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXc06frf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|c06frf| '|NagSeriesSummationPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "Computes the discrete Fourier transforms of {\it m} complex ") + (text . "sequences, each containing {\it n} data values.") + (text . "\blankline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "Enter the number of sequences to be transformed {\it m}: ") + (text . "\newline \tab{2} ") + (bcStrings (5 3 m PI)) + (text . "\blankline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "Enter the number of data values {\it n}: ") + (text . "\newline\tab{2} ") + (bcStrings (5 6 n PI)) + (text . "\blankline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "Type of call:") + (radioButtons init + ("" " Initial" i) + ("" " Subsequent" s) + ("" " Restart" r)) + (text . "\blankline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "Ifail value:") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'c06frfSolve) + htShowPage() + +c06frfSolve htPage == + m := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) + objValUnwrap htpLabelSpadValue(htPage, 'm) + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + call := htpButtonValue(htPage,'init) + init := + call = 'i => '"i" + call = 's => '"s" + '"r" + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + (n = '6 and m = '3) => c06frfDefaultSolve(htPage,init,ifail) + xList := + "append"/[fx(i,m) for i in 1..n] where fx(i,n) == + labelList := + "append"/[gx(i,j) for j in 1..n] where gx(i,j) == + xnam := INTERN STRCONC ('"x",STRINGIMAGE i, STRINGIMAGE j) + [['bcStrings,[6, 0.0, xnam, 'F]]] + prefix := ('"\newline \tab{2} ") + labelList := [['text,:prefix],:labelList] + yList := + "append"/[fy(i,m) for i in 1..n] where fy(i,n) == + labelList := + "append"/[gy(i,j) for j in 1..n] where gy(i,j) == + ynam := INTERN STRCONC ('"y",STRINGIMAGE i, STRINGIMAGE j) + [['bcStrings,[6, 0.0, ynam, 'F]]] + prefix := ('"\newline \tab{2} ") + labelList := [['text,:prefix],:labelList] + prefix := ('"\blankline \menuitemstyle{} \tab{2} Enter the imaginary parts ") + prefix := STRCONC(prefix,"of each sequence to be transformed, {\it y}. ") + prefix := STRCONC(prefix,"(Each column to contain the imaginary parts ") + prefix := STRCONC(prefix,"of a sequence.) \newline \tab{2} ") + yList := [['text,:prefix],:yList] + trigList := + "append"/[h(k) for k in 1..(2*n)] where h(k) == + prefix := ("\newline \tab{2} ") + trignam := INTERN STRCONC ('"t",STRINGIMAGE k) + [['text,:prefix],['bcStrings,[6, "0.0", trignam, 'F]]] + prefix := ('"\blankline \menuitemstyle{} \tab{2} Trignometric coefficients ") + prefix := STRCONC(prefix,"(not required if initial call) {\it TRIG}: ") + prefix := STRCONC(prefix,"\newline \tab{2} ") + trigList := [['text,:prefix],:trigList] + equationPart := [ + '(domainConditions + (isDomain F (Float))), + :xList,:yList,:trigList] + page := htInitPage("C06FRF - Multiple 1-D real discrete Fourier transform ", htpPropertyList htPage) + htSay '"\menuitemstyle{} \tab{2} " + htSay '"Enter the real parts of each sequence to be transformed, {\it x}. " + htSay '"(Each column to contain the real parts of a sequence.) " + htMakePage equationPart + htMakeDoneButton('"Continue",'c06frfGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'m,m) + htpSetProperty(page,'init,init) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +c06frfDefaultSolve (htPage, init,ifail) == + n := '6 + m := '3 + page := htInitPage('"C06FRF - Multiple 1-D real discrete Fourier transform ",nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Enter the real parts of each sequence to be transformed, ") + (text . "{\it x}. (Each column to contain the real parts of a sequence.) ") + (text . "\newline \tab{2} ") + (bcStrings (6 "0.3854" x11 F)) + (bcStrings (6 "0.9172" x21 F)) + (bcStrings (6 "0.1156" x31 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.6772" x12 F)) + (bcStrings (6 "0.0644" x22 F)) + (bcStrings (6 "0.0685" x32 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.1138" x13 F)) + (bcStrings (6 "0.6037" x23 F)) + (bcStrings (6 "0.2060" x33 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.6751" x14 F)) + (bcStrings (6 "0.6430" x24 F)) + (bcStrings (6 "0.8630" x34 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.6362" x15 F)) + (bcStrings (6 "0.0428" x25 F)) + (bcStrings (6 "0.6967" x35 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.1424" x16 F)) + (bcStrings (6 "0.4815" x26 F)) + (bcStrings (6 "0.2792" x36 F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Enter the imaginary parts of each ") + (text . "sequence to be transformed, {\it y}. ") + (text . "(Each column to contain the imaginary parts of a sequence.) ") + (text . "\newline \tab{2} ") + (bcStrings (6 "0.5417" y11 F)) + (bcStrings (6 "0.9089" y21 F)) + (bcStrings (6 "0.6214" y31 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.2983" y12 F)) + (bcStrings (6 "0.3118" y22 F)) + (bcStrings (6 "0.8681" y32 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.1181" y13 F)) + (bcStrings (6 "0.3465" y23 F)) + (bcStrings (6 "0.7060" y33 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.7255" y14 F)) + (bcStrings (6 "0.6198" y24 F)) + (bcStrings (6 "0.8652" y34 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.8638" y15 F)) + (bcStrings (6 "0.2668" y25 F)) + (bcStrings (6 "0.9190" y35 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.8723" y16 F)) + (bcStrings (6 "0.1614" y26 F)) + (bcStrings (6 "0.3355" y36 F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Trignometric coefficients (not required if initial call) ") + (text . "{\it TRIG}: \newline \tab{2} ") + (bcStrings (6 "0.0" t1 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" t2 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" t3 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" t4 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" t5 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" t6 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" t7 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" t8 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" t9 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" t10 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" t11 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" t12 F)) + (text . "\blankline ")) + htMakeDoneButton('"Continue",'c06frfGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'m,m) + htpSetProperty(page,'init,init) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +c06frfGen htPage == + n := htpProperty(htPage,'n) + m := htpProperty(htPage,'m) + init := htpProperty(htPage,'init) + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + for i in 1..(2*n) repeat + left := STRCONC((first y).1," ") + y := rest y + triglist := [left,:triglist] + trigstring := bcwords2liststring triglist + for i in 1..(m*n) repeat + left := STRCONC((first y).1," ") + y := rest y + ylist := [left,:ylist] + ystring := bcwords2liststring ylist + while y repeat + left := STRCONC((first y).1," ") + y := rest y + xlist := [left,:xlist] + xstring := bcwords2liststring xlist + prefix := STRCONC ('"c06frf(",STRINGIMAGE m,", ",STRINGIMAGE n,", _"") + prefix := STRCONC(prefix,init,"_",[",xstring,"],[",ystring,"],[") + linkGen STRCONC(prefix,trigstring,"],",STRINGIMAGE ifail,")") + + +c06fuf() == + htInitPage('"C06FUF - 2-D complex discrete Fourier transform ",nil) + htMakePage '( + (domainConditions + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXc06fuf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|c06fuf| '|NagSeriesSummationPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "Computes the two-dimensional discrete Fourier transform of ") + (text . "a bivaraite sequence of complex data values; likely to be ") + (text . "efficient on vector processors. ") + (text . "\blankline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "Enter the number of {\it m} of rows of X and Y; ") + (text . "\htbitmap{great=} 1 \newline \tab{2} ") + (bcStrings (5 3 m PI)) + (text . "\blankline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "Enter the number of {\it n} of columns of X and Y; ") + (text . "\htbitmap{great=} 1 \newline \tab{2} ") + (bcStrings (5 5 n PI)) + (text . "\blankline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "Type of call:") + (radioButtons init + ("" " Initial" i) + ("" " Subsequent" s) + ("" " Restart" r)) + (text . "\blankline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "Ifail value:") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'c06fufSolve) + htShowPage() + +c06fufSolve htPage == + m := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) + objValUnwrap htpLabelSpadValue(htPage, 'm) + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + call := htpButtonValue(htPage,'init) + init := + call = 'i => '"i" + call = 's => '"s" + '"r" + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + (n = '5 and m = '3) => c06fufDefaultSolve(htPage,init,ifail) + xList := + "append"/[fx(i,m) for i in 1..n] where fx(i,n) == + labelList := + "append"/[gx(i,j) for j in 1..n] where gx(i,j) == + xnam := INTERN STRCONC ('"x",STRINGIMAGE i, STRINGIMAGE j) + [['bcStrings,[6, 0.0, xnam, 'F]]] + prefix := ('"\newline \tab{2} ") + labelList := [['text,:prefix],:labelList] + yList := + "append"/[fy(i,m) for i in 1..n] where fy(i,n) == + labelList := + "append"/[gy(i,j) for j in 1..n] where gy(i,j) == + ynam := INTERN STRCONC ('"y",STRINGIMAGE i, STRINGIMAGE j) + [['bcStrings,[6, 0.0, ynam, 'F]]] + prefix := ('"\newline \tab{2} ") + labelList := [['text,:prefix],:labelList] + prefix := ('"\blankline \menuitemstyle{} \tab{2} Enter the imaginary parts ") + prefix := STRCONC(prefix,"of each sequence to be transformed, {\it y}. ") + prefix := STRCONC(prefix,"(Each column to contain the imaginary parts ") + prefix := STRCONC(prefix,"of a sequence.) \newline \tab{2} ") + yList := [['text,:prefix],:yList] + trigmList := + "append"/[hm(k) for k in 1..(2*m)] where hm(k) == + prefix := ("\newline \tab{2} ") + trignam := INTERN STRCONC ('"tm",STRINGIMAGE k) + [['text,:prefix],['bcStrings,[6, "0.0", trignam, 'F]]] + prefix := ('"\blankline \menuitemstyle{} \tab{2} Trignometric coefficients ") + prefix := STRCONC(prefix,"(not required if initial call) {\it TRIGM}: ") + prefix := STRCONC(prefix,"\newline \tab{2} ") + trigmList := [['text,:prefix],:trigmList] + trignList := + "append"/[hn(k) for k in 1..(2*n)] where hn(k) == + prefix := ("\newline \tab{2} ") + trignam := INTERN STRCONC ('"tn",STRINGIMAGE k) + [['text,:prefix],['bcStrings,[6, "0.0", trignam, 'F]]] + prefix := ('"\blankline \menuitemstyle{} \tab{2} {\it TRIGN}: ") + prefix := STRCONC(prefix,"\newline \tab{2} ") + trignList := [['text,:prefix],:trignList] + equationPart := [ + '(domainConditions + (isDomain F (Float))), + :xList,:yList,:trigmList,:trignList] + page := htInitPage("C06FUF - 2-D complex discrete Fourier transform ", htpPropertyList htPage) + htSay '"\menuitemstyle{} \tab{2} " + htSay '"Enter the real part of each sequence to be transformed, {\it x}. " + htSay '"(Each column to contain the real parts of a sequence.) " + htMakePage equationPart + htMakeDoneButton('"Continue",'c06fufGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'m,m) + htpSetProperty(page,'init,init) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +c06fufDefaultSolve (htPage, init,ifail) == + n := '5 + m := '3 + page := htInitPage('"C06FUF - 2-D real discrete Fourier transform ",nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Enter the real parts of each sequence to be transformed, ") + (text . "{\it x}. (Each column to contain the real parts of a sequence.) ") + (text . "\newline \tab{2} ") + (bcStrings (6 "1.000" x11 F)) + (bcStrings (6 "0.994" x21 F)) + (bcStrings (6 "0.903" x31 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.999" x12 F)) + (bcStrings (6 "0.989" x22 F)) + (bcStrings (6 "0.885" x32 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.987" x13 F)) + (bcStrings (6 "0.963" x23 F)) + (bcStrings (6 "0.823" x33 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.936" x14 F)) + (bcStrings (6 "0.891" x24 F)) + (bcStrings (6 "0.694" x34 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.802" x15 F)) + (bcStrings (6 "0.731" x25 F)) + (bcStrings (6 "0.467" x35 F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Enter the imaginary parts of each ") + (text . "sequence to be transformed, {\it y}. (Each column to contain ") + (text . "the imaginary parts of a sequence.) ") + (text . "\newline \tab{2} ") + (bcStrings (6 "0.000" y11 F)) + (bcStrings (6 "-0.111" y21 F)) + (bcStrings (6 "-0.430" y31 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "-0.040" y12 F)) + (bcStrings (6 "-0.151" y22 F)) + (bcStrings (6 "-0.466" y32 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "-0.159" y13 F)) + (bcStrings (6 "-0.268" y23 F)) + (bcStrings (6 "-0.568" y33 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "-0.352" y14 F)) + (bcStrings (6 "-0.454" y24 F)) + (bcStrings (6 "-0.720" y34 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "-0.597" y15 F)) + (bcStrings (6 "-0.682" y25 F)) + (bcStrings (6 "-0.884" y35 F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Trignometric coefficients (not required if initial call) ") + (text . "{\it TRIGM}: \newline \tab{2} ") + (bcStrings (6 "0.0" tm1 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" tm2 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" tm3 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" tm4 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" tm5 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" tm6 F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "{\it TRIGN}: \newline \tab{2} ") + (bcStrings (6 "0.0" tn1 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" tn2 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" tn3 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" tn4 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" tn5 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" tn6 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" tn7 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" tn8 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" tn9 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" tn10 F)) + (text . "\blankline ")) + htMakeDoneButton('"Continue",'c06fufGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'m,m) + htpSetProperty(page,'init,init) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +c06fufGen htPage == + n := htpProperty(htPage,'n) + m := htpProperty(htPage,'m) + init := htpProperty(htPage,'init) + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + for i in 1..(2*n) repeat + left := STRCONC((first y).1," ") + y := rest y + trignlist := [left,:trignlist] + trignstring := bcwords2liststring trignlist + for i in 1..(2*m) repeat + left := STRCONC((first y).1," ") + y := rest y + trigmlist := [left,:trigmlist] + trigmstring := bcwords2liststring trigmlist + for i in 1..(m*n) repeat + left := STRCONC((first y).1," ") + y := rest y + ylist := [left,:ylist] + ystring := bcwords2liststring ylist + while y repeat + left := STRCONC((first y).1," ") + y := rest y + xlist := [left,:xlist] + xstring := bcwords2liststring xlist + prefix := STRCONC ('"c06fuf(",STRINGIMAGE m,", ",STRINGIMAGE n,", _"") + prefix := STRCONC(prefix,init,"_",[",xstring,"],[",ystring,"],[",trigmstring) + linkGen STRCONC(prefix,"],[",trignstring,"],",STRINGIMAGE ifail,")") + + + +c06gbf() == + htInitPage('"C06GBF - Complex conjugate of a Hermitian sequence ",nil) + htMakePage '( + (domainConditions + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXc06gbf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|c06gbf| '|NagSeriesSummationPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "Forms the complex conjugate of a Hermitian sequence of {\it n} data values") + (text . "\newline ") + (text . "\blankline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "Enter the number of data values {\it n} ") + (text . "\space{1} \inputbitmap{\htbmdir{}/great=.bitmap} 1 ") + (text . "\newline\tab{2} ") + (bcStrings (5 7 n PI)) + (text . "\blankline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "Ifail value:") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'c06gbfSolve) + htShowPage() + +c06gbfSolve htPage == + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + n = '7 => c06gbfDefaultSolve(htPage,ifail) + labelList := + "append"/[f(i) for i in 1..n] where f(i) == + prefix := ('"\newline \tab{15} ") + rnam := INTERN STRCONC ('"r",STRINGIMAGE i) + [['text,:prefix],['bcStrings,[10, 0.0, rnam, 'F]]] + equationPart := [ + '(domainConditions + (isDomain F (Float))), + :labelList] + page := htInitPage("C06GBF - Complex conjugate of a Hermitian sequence ", htpPropertyList htPage) + htSay '"\menuitemstyle{} \tab{2} " + htSay '"Enter the Hermitian sequence to be transformed stored in Hermitian form: " + htMakePage equationPart + htSay '"\blankline " + htSay '"Note : On exit, the imaginary values are negated " + htSay '"\blankline " + htMakeDoneButton('"Continue",'c06gbfGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +c06gbfDefaultSolve (htPage, ifail) == + n := '7 + page := htInitPage('"C06GBF - Complex conjugate of a Hermitian sequence ", nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Enter the Hermitian sequence to be transformed ") + (text . "stored in Hermitian form: ") + (text . "\newline \tab{15} ") + (bcStrings (10 "0.34907" r1 F)) + (text . "\newline \tab{15} ") + (bcStrings (10 "0.54890" r2 F)) + (text . "\newline \tab{15} ") + (bcStrings (10 "0.74776" r3 F)) + (text . "\newline \tab{15} ") + (bcStrings (10 "0.94459" r4 F)) + (text . "\newline \tab{15} ") + (bcStrings (10 "1.13850" r5 F)) + (text . "\newline \tab{15} ") + (bcStrings (10 "1.32850" r6 F)) + (text . "\newline \tab{15} ") + (bcStrings (10 "1.51370" r7 F)) + (text . "\blankline ") + (text . "Note : On exit, the imaginary values are negated ") + (text . "\blankline ")) + htMakeDoneButton('"Continue",'c06gbfGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +c06gbfGen htPage == + n := htpProperty(htPage,'n) + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + while y repeat + left := STRCONC((first y).1," ") + y := rest y + reallist := [left,:reallist] + realstring := bcwords2liststring reallist + linkGen STRCONC ('"c06gbf(",STRINGIMAGE n,",[",realstring,"],",STRINGIMAGE ifail,")") + + +c06gcf() == + htInitPage('"C06GCF - Complex conjugate of complex sequence ",nil) + htMakePage '( + (domainConditions + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXc06gcf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|c06gcf| '|NagSeriesSummationPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\newline ") + (text . "Forms the complex conjugate of a sequence of {\it n} data values") + (text . "\newline ") + (text . "\blankline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "Enter the number of data values {\it n} ") + (text . "\space{1} \inputbitmap{\htbmdir{}/great=.bitmap} 1 ") + (text . "\newline\tab{2} ") + (bcStrings (5 7 n PI)) + (text . "\blankline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "Ifail value:") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'c06gcfSolve) + htShowPage() + +c06gcfSolve htPage == + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + n = '7 => c06gcfDefaultSolve(htPage,ifail) + labelList := + "append"/[f(i) for i in 1..n] where f(i) == + prefix := ('"\newline \tab{15} ") + rnam := INTERN STRCONC ('"r",STRINGIMAGE i) + [['text,:prefix],['bcStrings,[10, 0.0, rnam, 'F]]] + equationPart := [ + '(domainConditions + (isDomain F (Float))), + :labelList] + page := htInitPage("C06GCF - Complex conjugate of a Hermitian sequence ", htpPropertyList htPage) + htSay '"\menuitemstyle{} \tab{2} " + htSay '"Enter the imaginary parts of the sequence: " + htMakePage equationPart + htSay '"\blankline " + htSay '"Note : On exit, these values are negated " + htSay '"\blankline " + htMakeDoneButton('"Continue",'c06gcfGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +c06gcfDefaultSolve (htPage, ifail) == + n := '7 + page := htInitPage('"C06GCF - Complex conjugate of complex sequence ", nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Enter the imaginary parts of the sequence: ") + (text . "\newline \tab{15} ") + (bcStrings (10 "-0.37168" r1 F)) + (text . "\newline \tab{15} ") + (bcStrings (10 "-0.35669" r2 F)) + (text . "\newline \tab{15} ") + (bcStrings (10 "-0.31175" r3 F)) + (text . "\newline \tab{15} ") + (bcStrings (10 "-0.23702" r4 F)) + (text . "\newline \tab{15} ") + (bcStrings (10 "0.00074" r5 F)) + (text . "\newline \tab{15} ") + (bcStrings (10 "0.16298" r6 F)) + (text . "\newline \tab{15} ") + (bcStrings (10 "1.51370" r7 F)) + (text . "\blankline ") + (text . "Note : On exit, these values are negated ") + (text . "\blankline ")) + htMakeDoneButton('"Continue",'c06gcfGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +c06gcfGen htPage == + n := htpProperty(htPage,'n) + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + while y repeat + left := STRCONC((first y).1," ") + y := rest y + reallist := [left,:reallist] + realstring := bcwords2liststring reallist + linkGen STRCONC ('"c06gcf(",STRINGIMAGE n,",[",realstring,"],",STRINGIMAGE ifail,")") + +c06gqf() == + htInitPage('"C06GQF - Complex conjugate of multiple Hermitian sequences ",nil) + htMakePage '( + (domainConditions + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXc06gqf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|c06gqf| '|NagSeriesSummationPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "Forms the complex conjugates of {\it m} Hermitian sequences, ") + (text . "each containing {\it n} data values. ") + (text . "\newline ") + (text . "\blankline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "Enter the number {\it m} \inputbitmap{\htbmdir{}/great=.bitmap} 1 ") + (text . "of sequences to be tranformed: ") + (text . "\newline\tab{2} ") + (bcStrings (5 3 m PI)) + (text . "\blankline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "Enter the number {\it n} \inputbitmap{\htbmdir{}/great=.bitmap} 1 ") + (text . "of data values in each sequence: ") + (text . "\newline\tab{2} ") + (bcStrings (5 6 n PI)) + (text . "\blankline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "Ifail value:") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'c06gqfSolve) + htShowPage() + + +c06gqfSolve htPage == + m := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) + objValUnwrap htpLabelSpadValue(htPage, 'm) + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + (m = '3 and n = '6) => c06gqfDefaultSolve(htPage,ifail) + newList:= + "append"/[g(i,m) for i in 1..n] where g(i,n) == + labelList := + "append"/[f(i,j) for j in 1..n] where f(i,j) == + rnam := INTERN STRCONC ('"r",STRINGIMAGE i,STRINGIMAGE j) + [['bcStrings,[6, 0.0, rnam, 'P]]] + prefix := ('"\newline \tab{2} ") + labelList := [['text,:prefix],:labelList] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :newList] + page := htInitPage("C06GQF - Complex conjugate of multiple Hermitian sequences ",htpPropertyList htPage) + htSay '"\newline " + htSay '"\menuitemstyle{}\tab{2} Please enter each sequence to be " + htSay '"transformed in Hermitian format. (Each column to contain " + htSay '"a sequence.) " + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'c06gqfGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'m,m) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +c06gqfDefaultSolve (htPage, ifail) == + m := '3 + n := '6 + page := htInitPage('"C06GQF - Complex conjugate of multiple Hermitian sequences ",htpPropertyList htPage) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Please enter each sequence to be ") + (text . "transformed in Hermitian format. ") + (text . "(Each column to contain a sequence.) ") + (text . "\newline \tab{2} ") + (bcStrings (6 "0.3854" x11 F)) + (bcStrings (6 "0.5417" x21 F)) + (bcStrings (6 "0.9172" x31 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.6772" x12 F)) + (bcStrings (6 "0.2983" x22 F)) + (bcStrings (6 "0.0644" x32 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.1138" x13 F)) + (bcStrings (6 "0.1181" x23 F)) + (bcStrings (6 "0.6037" x33 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.6751" x14 F)) + (bcStrings (6 "0.7255" x24 F)) + (bcStrings (6 "0.6430" x34 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.6362" x15 F)) + (bcStrings (6 "0.8638" x25 F)) + (bcStrings (6 "0.0428" x35 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.1424" x16 F)) + (bcStrings (6 "0.8723" y26 F)) + (bcStrings (6 "0.4815" y36 F)) + (text . "\blankline")) + htMakeDoneButton('"Continue",'c06gqfGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'m,m) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +c06gqfGen htPage == + n := htpProperty(htPage,'n) + m := htpProperty(htPage,'m) + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + while y repeat + right := STRCONC ((first y).1," ") + y := rest y + reallist := [right,:reallist] + realstring := bcwords2liststring reallist + linkGen STRCONC ('"c06gqf(",STRINGIMAGE m,",",STRINGIMAGE n,",[",realstring,"],", STRINGIMAGE ifail,")") + + + +c06gsf() == + htInitPage('"C06GSF - Convert Hermitian sequences to general complex sequences", nil) + htMakePage '( + (domainConditions + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXc06gsf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|c06gsf| '|NagSeriesSummationPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "Takes {\it m} Hermitian sequences, each containing {\it n} data values, ") + (text . "and forms the real and imaginary parts of the {\it m} ") + (text . "corresponding complex sequences. \newline ") + (text . "\blankline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "Enter the number {\it m} \inputbitmap{\htbmdir{}/great=.bitmap} 1 ") + (text . "of sequences to be transformed: ") + (text . "\newline\tab{2} ") + (bcStrings (5 3 m PI)) + (text . "\blankline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "Enter the number {\it n} \inputbitmap{\htbmdir{}/great=.bitmap} 1 ") + (text . "of data values in each sequence: ") + (text . "\newline\tab{2} ") + (bcStrings (5 6 n PI)) + (text . "\blankline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "Ifail value:") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'c06gsfSolve) + htShowPage() + + +c06gsfSolve htPage == + m := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) + objValUnwrap htpLabelSpadValue(htPage, 'm) + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + (m = '3 and n = '6) => c06gsfDefaultSolve(htPage,ifail) + newList:= + "append"/[g(i,m) for i in 1..n] where g(i,n) == + labelList := + "append"/[f(i,j) for j in 1..n] where f(i,j) == + rnam := INTERN STRCONC ('"r",STRINGIMAGE i,STRINGIMAGE j) + [['bcStrings,[6, 0.0, rnam, 'P]]] + prefix := ('"\newline \tab{2} ") + labelList := [['text,:prefix],:labelList] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :newList] + page := htInitPage("C06GSF - Convert Hermitian sequences to general complex sequences ",htpPropertyList htPage) + htSay '"\newline " + htSay '"\menuitemstyle{}\tab{2} Please enter each sequence to be " + htSay '"transformed in Hermitian format. (Each column to contain a " + htSay '"sequence.) " + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'c06gsfGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'m,m) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +c06gsfDefaultSolve (htPage, ifail) == + m := '3 + n := '6 + page := htInitPage('"C06GSF - Convert Hermitian sequences to general complex sequences ",htpPropertyList htPage) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Please enter each sequence to be ") + (text . "transformed in Hermitian format. (Each column to contain a ") + (text . "sequence.) ") + (text . "\newline \tab{2} ") + (bcStrings (6 "0.3854" x11 F)) + (bcStrings (6 "0.5417" x21 F)) + (bcStrings (6 "0.9172" x31 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.6772" x12 F)) + (bcStrings (6 "0.2983" x22 F)) + (bcStrings (6 "0.0644" x32 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.1138" x13 F)) + (bcStrings (6 "0.1181" x23 F)) + (bcStrings (6 "0.6037" x33 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.6751" x14 F)) + (bcStrings (6 "0.7255" x24 F)) + (bcStrings (6 "0.6430" x34 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.6362" x15 F)) + (bcStrings (6 "0.8638" x25 F)) + (bcStrings (6 "0.0428" x35 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.1424" x16 F)) + (bcStrings (6 "0.8723" y26 F)) + (bcStrings (6 "0.4815" y36 F)) + (text . "\blankline")) + htMakeDoneButton('"Continue",'c06gsfGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'m,m) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +c06gsfGen htPage == + n := htpProperty(htPage,'n) + m := htpProperty(htPage,'m) + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + while y repeat + right := STRCONC ((first y).1," ") + y := rest y + reallist := [right,:reallist] + realstring := bcwords2liststring reallist + linkGen STRCONC ('"c06gsf(",STRINGIMAGE m,",",STRINGIMAGE n,",[",realstring,"],", STRINGIMAGE ifail,")") + + diff --git a/src/interp/nag-c06.boot.pamphlet b/src/interp/nag-c06.boot.pamphlet deleted file mode 100644 index 6ea240c3..00000000 --- a/src/interp/nag-c06.boot.pamphlet +++ /dev/null @@ -1,1856 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp nag-c06.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. - -@ -<<*>>= -<> - -)package "BOOT" - -c06eaf() == - htInitPage('"C06EAF - Single 1-D real discrete Fourier transform ",nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXc06eaf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|c06eaf| '|NagSeriesSummationPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "Calculates the discrete Fourier transform of the sequence ") - (text . "of real data values \space{1} \inputbitmap{\htbmdir{}/xj.bitmap}, for ") - (text . "j = 0,1,...,n-1. ") - (text . "\newline ") - (text . "\blankline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "Enter the number of data values: ") - (text . "\newline\tab{2} ") - (bcStrings (5 7 n PI)) - (text . "\blankline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "Ifail value:") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'c06eafSolve) - htShowPage() - -c06eafSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - n = '7 => c06eafDefaultSolve(htPage,ifail) - labelList := - "append"/[f(i) for i in 1..n] where f(i) == - prefix := ('"\newline \tab{15} ") - rnam := INTERN STRCONC ('"r",STRINGIMAGE i) - [['text,:prefix],['bcStrings,[10, 0.0, rnam, 'F]]] - equationPart := [ - '(domainConditions - (isDomain F (Float))), - :labelList] - page := htInitPage("C06EAF - Single 1-D real discrete Fourier transform ", htpPropertyList htPage) - htSay '"\menuitemstyle{} \tab{2} " - htSay '"Enter the sequence to be transformed: " - htMakePage equationPart - htSay '"\blankline " - htSay '"Note : On exit, the transformed sequence is stored " - htSay '"in Hermitian form " - htSay '"\blankline " - htMakeDoneButton('"Continue",'c06eafGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -c06eafDefaultSolve (htPage, ifail) == - n := '7 - page := htInitPage('"C06EAF - Single 1-D real discrete Fourier transform ",nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Enter the sequence to be transformed: ") - (text . "\newline \tab{15} ") - (bcStrings (10 "0.34907" r1 F)) - (text . "\newline \tab{15} ") - (bcStrings (10 "0.54890" r2 F)) - (text . "\newline \tab{15} ") - (bcStrings (10 "0.74776" r3 F)) - (text . "\newline \tab{15} ") - (bcStrings (10 "0.94459" r4 F)) - (text . "\newline \tab{15} ") - (bcStrings (10 "1.13850" r5 F)) - (text . "\newline \tab{15} ") - (bcStrings (10 "1.32850" r6 F)) - (text . "\newline \tab{15} ") - (bcStrings (10 "1.51370" r7 F)) - (text . "\blankline ") - (text . "Note : On exit, the transformed sequence is stored ") - (text . "in Hermitian form ") - (text . "\blankline ")) - htMakeDoneButton('"Continue",'c06eafGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -c06eafGen htPage == - n := htpProperty(htPage,'n) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - while y repeat - left := STRCONC((first y).1," ") - y := rest y - reallist := [left,:reallist] - realstring := bcwords2liststring reallist - linkGen STRCONC ('"c06eaf(",STRINGIMAGE n,",[",realstring,"],",STRINGIMAGE ifail,")") - -c06ebf() == - htInitPage('"C06EBF - Single 1-D Hermitian discrete Fourier transform ",nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXc06ebf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|c06ebf| '|NagSeriesSummationPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "Calculates the discrete Fourier transform of a Hermitian ") - (text . "sequence of complex data values. ") - (text . "\newline ") - (text . "\blankline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "Enter the number of data values: ") - (text . "\newline \tab{2}") - (bcStrings (5 7 n PI)) - (text . "\blankline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'c06ebfSolve) - htShowPage() - -c06ebfSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - n = '7 => c06ebfDefaultSolve(htPage,ifail) - labelList := - "append"/[f(i) for i in 1..n] where f(i) == - prefix := ('"\newline \tab{15} ") - rnam := INTERN STRCONC ('"r",STRINGIMAGE i) - [['text,:prefix],['bcStrings,[10, 0.0, rnam, 'F]]] - equationPart := [ - '(domainConditions - (isDomain F (Float))), - :labelList] - page := htInitPage("C06EBF - Single 1-D real discrete Fourier transform ", htpPropertyList htPage) - htSay '"\menuitemstyle{} \tab{2} " - htSay '"Enter the sequence to be transformed, stored in Hermitian form: " - htMakePage equationPart - htSay '"\blankline " - htSay '"Note : On exit, the components of the discrete Fourier transform " - htSay '"\blankline " - htMakeDoneButton('"Continue",'c06ebfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -c06ebfDefaultSolve (htPage, ifail) == - n := '7 - page := htInitPage('"C06EBF - Single 1-D Hermitian discrete Fourier transform ",nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Enter the sequence to be transformed, stored in Hermitian form: ") - (text . "\newline \tab{15} ") - (bcStrings (10 "0.34907" r1 F)) - (text . "\newline \tab{15} ") - (bcStrings (10 "0.54890" r2 F)) - (text . "\newline \tab{15} ") - (bcStrings (10 "0.74776" r3 F)) - (text . "\newline \tab{15} ") - (bcStrings (10 "0.94459" r4 F)) - (text . "\newline \tab{15} ") - (bcStrings (10 "1.13850" r5 F)) - (text . "\newline \tab{15} ") - (bcStrings (10 "1.32850" r6 F)) - (text . "\newline \tab{15} ") - (bcStrings (10 "1.51370" r7 F)) - (text . "\blankline ") - (text . "Note : On exit, the components of the discrete Fourier transform") - (text . "\blankline ")) - htMakeDoneButton('"Continue",'c06ebfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -c06ebfGen htPage == - n := htpProperty(htPage,'n) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - while y repeat - left := STRCONC((first y).1," ") - y := rest y - reallist := [left,:reallist] - realstring := bcwords2liststring reallist - linkGen STRCONC ('"c06ebf(",STRINGIMAGE n,",[",realstring,"],",STRINGIMAGE ifail,")") - - -c06ecf() == - htInitPage('"C06ECF - Single 1-D complex discrete Fourier transform ",nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXc06ecf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|c06ecf| '|NagSeriesSummationPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "Calculates the discrete Fourier transform of a complex sequence.") - (text . "\newline ") - (text . "\blankline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "Enter the number of data values: ") - (text . "\newline\tab{2} ") - (bcStrings (5 7 n PI)) - (text . "\blankline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "Ifail value:") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'c06ecfSolve) - htShowPage() - - -c06ecfSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - n = '7 => c06ecfDefaultSolve(htPage,ifail) - labelList := - "append"/[f(i) for i in 1..n] where f(i) == - prefix := ('"\newline \tab{2} ") - post := ('"\tab{32} ") - xnam := INTERN STRCONC ('"x",STRINGIMAGE i) - ynam := INTERN STRCONC ('"y",STRINGIMAGE i) - [['text,:prefix],['bcStrings,[10, 0.0, xnam, 'F]], - ['text,:post],['bcStrings,[10, 0.0, ynam, 'F]]] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :labelList] - page := htInitPage("C06ECF - Single 1-D complex discrete Fourier transform ",htpPropertyList htPage) - htSay '"\menuitemstyle{}\tab{2} Real parts of sequence: \tab{30} " - htSay '"\menuitemstyle{}\tab{32} Imaginary parts: " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'c06ecfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -c06ecfDefaultSolve (htPage, ifail) == - n := '7 - page := htInitPage('"C06ECF - Single 1-D complex discrete Fourier transform ",htpPropertyList htPage) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Real parts of sequence: \tab{30} ") - (text . "\menuitemstyle{}\tab{32} Imaginary parts: ") - (text . "\newline \tab{2}") - (bcStrings (10 "0.34907" x1 F)) - (text . "\tab{32} ") - (bcStrings (10 "-0.37168" y1 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.54890" x2 F)) - (text . "\tab{32} ") - (bcStrings (10 "-0.35669" y2 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.74776" x3 F)) - (text . "\tab{32} ") - (bcStrings (10 "-0.31175" y3 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.94459" x4 F)) - (text . "\tab{32} ") - (bcStrings (10 "-0.23702" y4 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "1.13850" x5 F)) - (text . "\tab{32} ") - (bcStrings (10 "-0.13274" y5 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "1.32850" x6 F)) - (text . "\tab{32} ") - (bcStrings (10 "0.00074" y6 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "1.51370" x7 F)) - (text . "\tab{32} ") - (bcStrings (10 "0.16298" y7 F)) - (text . "\blankline")) - htMakeDoneButton('"Continue",'c06ecfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -c06ecfGen htPage == - n := htpProperty(htPage,'n) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - while y repeat - right := STRCONC ((first y).1," ") - y := rest y - left := STRCONC ((first y).1," ") - y := rest y - reallist := [left,:reallist] - imaglist := [right,:imaglist] - realstring := bcwords2liststring reallist - imagstring := bcwords2liststring imaglist - linkGen STRCONC ('"c06ecf(",STRINGIMAGE n,",[",realstring,"],[",imagstring,"],", STRINGIMAGE ifail,")") - - -c06ekf() == - htInitPage('"C06EKF - Circular convolution or correlation of two real vectors",nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXc06ekf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|c06ekf| '|NagSeriesSummationPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "Calculates the circular convolution or correlation of two real ") - (text . "vectors of period {\em n} ") - (text . "\newline ") - (text . "\blankline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "Enter the number of data values: ") - (text . "\newline\tab{2} ") - (bcStrings (5 9 n PI)) - (text . "\blankline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "Choose the computation to be performed:") - (radioButtons job - ("" " Convolution" conv) - ("" " Correlation" corr)) - (text . "\blankline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "Ifail value:") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'c06ekfSolve) - htShowPage() - - -c06ekfSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - type := htpButtonValue(htPage,'job) - job := - type = 'conv => '1 - '2 - n = '9 => c06ekfDefaultSolve(htPage,job,ifail) - labelList := - "append"/[f(i) for i in 1..n] where f(i) == - prefix := ('"\newline \tab{2} ") - post := ('"\tab{34} ") - xnam := INTERN STRCONC ('"x",STRINGIMAGE i) - ynam := INTERN STRCONC ('"y",STRINGIMAGE i) - [['text,:prefix],['bcStrings,[10, 0.0, xnam, 'F]], - ['text,:post],['bcStrings,[10, 0.0, ynam, 'F]]] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :labelList] - page := htInitPage("C06EKF - Single 1-D complex discrete Fourier transform ",htpPropertyList htPage) - htSay '"\menuitemstyle{}\tab{2} Elements of period of vector {\em x}: " - htSay '"\tab{31} " - htSay '"\menuitemstyle{}\tab{34} Elements of period of vector {\em y}:" - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'c06ekfGen) - htpSetProperty(page,'job,job) - htpSetProperty(page,'n,n) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -c06ekfDefaultSolve (htPage, job, ifail) == - n := '9 - page := htInitPage('"C06EKF - Circular convolution or correlation of two real vectors ",htpPropertyList htPage) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Elements of period of vector {\em x}: \tab{32} ") - (text . "\menuitemstyle{}\tab{34} Elements of period of vector {\em y}: ") - (text . "\newline \tab{2}") - (bcStrings (10 "1.00" x1 F)) - (text . "\tab{34} ") - (bcStrings (10 "0.50" y1 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "1.00" x2 F)) - (text . "\tab{34} ") - (bcStrings (10 "0.50" y2 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "1.00" x3 F)) - (text . "\tab{34} ") - (bcStrings (10 "0.50" y3 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "1.00" x4 F)) - (text . "\tab{34} ") - (bcStrings (10 "0.50" y4 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "1.00" x5 F)) - (text . "\tab{34} ") - (bcStrings (10 "0.00" y5 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.00" x6 F)) - (text . "\tab{34} ") - (bcStrings (10 "0.00" y6 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.00" x7 F)) - (text . "\tab{34} ") - (bcStrings (10 "0.00" y7 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.00" x8 F)) - (text . "\tab{34} ") - (bcStrings (10 "0.00" y8 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.00" x9 F)) - (text . "\tab{34} ") - (bcStrings (10 "0.00" y9 F)) - (text . "\blankline")) - htMakeDoneButton('"Continue",'c06ekfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'job,job) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -c06ekfGen htPage == - n := htpProperty(htPage,'n) - ifail := htpProperty(htPage,'ifail) - job := htpProperty(htPage,'job) - alist := htpInputAreaAlist htPage - y := alist - while y repeat - right := STRCONC ((first y).1," ") - y := rest y - left := STRCONC ((first y).1," ") - y := rest y - reallist := [left,:reallist] - imaglist := [right,:imaglist] - realstring := bcwords2liststring reallist - imagstring := bcwords2liststring imaglist - linkGen STRCONC ('"c06ekf(",STRINGIMAGE job,",",STRINGIMAGE n,",[",realstring,"],[",imagstring,"],", STRINGIMAGE ifail,")") - -c06fpf() == - htInitPage('"C06FPF - Multiple 1-D real discrete Fourier transform ",nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXc06fpf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|c06fpf| '|NagSeriesSummationPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "Computes the discrete Fourier transforms of {\it m} real ") - (text . "sequences, each containing {\it n} data values.") - (text . "\blankline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "Enter the number of sequences to be transformed {\it m}: ") - (text . "\newline \tab{2} ") - (bcStrings (5 3 m PI)) - (text . "\blankline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "Enter the number of data values {\it n}: ") - (text . "\newline\tab{2} ") - (bcStrings (5 6 n PI)) - (text . "\blankline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "Type of call:") - (radioButtons init - ("" " Initial" i) - ("" " Subsequent" s) - ("" " Restart" r)) - (text . "\blankline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "Ifail value:") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'c06fpfSolve) - htShowPage() - -c06fpfSolve htPage == - m := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) - objValUnwrap htpLabelSpadValue(htPage, 'm) - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - call := htpButtonValue(htPage,'init) - init := - call = 'i => '"i" - call = 's => '"s" - '"r" - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - (n = '6 and m = '3) => c06fpfDefaultSolve(htPage,init,ifail) - matList := - "append"/[f(i,m) for i in 1..n] where f(i,n) == - labelList := - "append"/[g(i,j) for j in 1..n] where g(i,j) == - xnam := INTERN STRCONC ('"r",STRINGIMAGE i, STRINGIMAGE j) - [['bcStrings,[6, 0.0, xnam, 'F]]] - prefix := ('"\newline \tab{2} ") - labelList := [['text,:prefix],:labelList] - trigList := - "append"/[h(k) for k in 1..(2*n)] where h(k) == - prefix := ('"\newline \tab{2} ") - trignam := INTERN STRCONC ('"t",STRINGIMAGE k) - [['text,:prefix],['bcStrings,[6, "0.0", trignam, 'F]]] - prefix := ('"\blankline \menuitemstyle{} \tab{2} Trigonometric coefficients ") - prefix := STRCONC(prefix,"(not required if initial call) {\it TRIG}: ") - prefix := STRCONC(prefix,"\newline \tab{2} ") - trigList := [['text,:prefix],:trigList] - equationPart := [ - '(domainConditions - (isDomain F (Float))), - :matList,:trigList] - page := htInitPage("C06FPF - Multiple 1-D real discrete Fourier transform ", htpPropertyList htPage) - htSay '"\menuitemstyle{} \tab{2} " - htSay '"Enter each sequence to be transformed, {\it x}. " - htSay '"(Each column to contain a sequence.) " - htMakePage equationPart - htMakeDoneButton('"Continue",'c06fpfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) - htpSetProperty(page,'init,init) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -c06fpfDefaultSolve (htPage, init,ifail) == - n := '6 - m := '3 - page := htInitPage('"C06FPF - Multiple 1-D real discrete Fourier transform ",nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Enter each sequence to be transformed, {\it x}. ") - (text . "(Each column to contain a sequence.) ") - (text . "\newline \tab{2} ") - (bcStrings (6 "0.3854" x11 F)) - (bcStrings (6 "0.5417" x21 F)) - (bcStrings (6 "0.9172" x31 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.6772" x12 F)) - (bcStrings (6 "0.2983" x22 F)) - (bcStrings (6 "0.0644" x32 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.1138" x13 F)) - (bcStrings (6 "0.1181" x23 F)) - (bcStrings (6 "0.6037" x33 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.6751" x14 F)) - (bcStrings (6 "0.7255" x24 F)) - (bcStrings (6 "0.6430" x34 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.6362" x15 F)) - (bcStrings (6 "0.8638" x25 F)) - (bcStrings (6 "0.0428" x35 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.1424" x16 F)) - (bcStrings (6 "0.8723" x26 F)) - (bcStrings (6 "0.4815" x36 F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Trignometric coefficients (not required if initial call) ") - (text . "{\it TRIG}: \newline \tab{2} ") - (bcStrings (6 "0.0" t1 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" t2 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" t3 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" t4 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" t5 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" t6 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" t7 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" t8 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" t9 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" t10 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" t11 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" t12 F)) - (text . "\blankline ")) - htMakeDoneButton('"Continue",'c06fpfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) - htpSetProperty(page,'init,init) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -c06fpfGen htPage == - n := htpProperty(htPage,'n) - m := htpProperty(htPage,'m) - init := htpProperty(htPage,'init) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - for i in 1..(2*n) repeat - left := STRCONC((first y).1," ") - y := rest y - triglist := [left,:triglist] - trigstring := bcwords2liststring triglist - while y repeat - left := STRCONC((first y).1," ") - y := rest y - xlist := [left,:xlist] - xstring := bcwords2liststring xlist - prefix := STRCONC ('"c06fpf(",STRINGIMAGE m,", ",STRINGIMAGE n,", _"") - prefix := STRCONC(prefix,init,"_",[",xstring,"],[",trigstring,"],") - linkGen STRCONC(prefix,STRINGIMAGE ifail,")") - - -c06fqf() == - htInitPage('"C06FQF - Multiple 1-D Hermitian discrete Fourier transform ",nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXc06fqf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|c06fqf| '|NagSeriesSummationPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "Computes the discrete Fourier transforms of {\it m} real ") - (text . "sequences, each containing {\it n} data values.") - (text . "\blankline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "Enter the number of sequences to be transformed {\it m}: ") - (text . "\newline \tab{2} ") - (bcStrings (5 3 m PI)) - (text . "\blankline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "Enter the number of data values {\it n}: ") - (text . "\newline\tab{2} ") - (bcStrings (5 6 n PI)) - (text . "\blankline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "Type of call:") - (radioButtons init - ("" " Initial" i) - ("" " Subsequent" s) - ("" " Restart" r)) - (text . "\blankline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "Ifail value:") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'c06fqfSolve) - htShowPage() - -c06fqfSolve htPage == - m := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) - objValUnwrap htpLabelSpadValue(htPage, 'm) - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - call := htpButtonValue(htPage,'init) - init := - call = 'i => '"i" - call = 's => '"s" - '"r" - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - (n = '6 and m = '3) => c06fqfDefaultSolve(htPage,init,ifail) - matList := - "append"/[f(i,m) for i in 1..n] where f(i,n) == - labelList := - "append"/[g(i,j) for j in 1..n] where g(i,j) == - xnam := INTERN STRCONC ('"r",STRINGIMAGE i, STRINGIMAGE j) - [['bcStrings,[6, 0.0, xnam, 'F]]] - prefix := ('"\newline \tab{2} ") - labelList := [['text,:prefix],:labelList] - trigList := - "append"/[h(k) for k in 1..(2*n)] where h(k) == - prefix := ("\newline \tab{2} ") - trignam := INTERN STRCONC ('"t",STRINGIMAGE k) - [['text,:prefix],['bcStrings,[6, "0.0", trignam, 'F]]] - prefix := ('"\blankline \menuitemstyle{} \tab{2} Trignometric coefficients ") - prefix := STRCONC(prefix,"(not required if initial call) {\it TRIG}: ") - prefix := STRCONC(prefix,"\newline \tab{2} ") - trigList := [['text,:prefix],:trigList] - equationPart := [ - '(domainConditions - (isDomain F (Float))), - :matList,:trigList] - page := htInitPage("C06FQF - Multiple 1-D Hermitian discrete Fourier transform ", htpPropertyList htPage) - htSay '"\menuitemstyle{} \tab{2} " - htSay '"Enter each sequence to be transformed, {\it x}. " - htSay '"(Each column to contain a sequence.) " - htMakePage equationPart - htMakeDoneButton('"Continue",'c06fqfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) - htpSetProperty(page,'init,init) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -c06fqfDefaultSolve (htPage, init,ifail) == - n := '6 - m := '3 - page := htInitPage('"C06FQF - Multiple 1-D Hermitian discrete Fourier transform ",nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Enter each sequence to be transformed, {\it x}. ") - (text . "(Each column to contain a sequence.) ") - (text . "\newline \tab{2} ") - (bcStrings (6 "0.3854" x11 F)) - (bcStrings (6 "0.5417" x21 F)) - (bcStrings (6 "0.9172" x31 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.6772" x12 F)) - (bcStrings (6 "0.2983" x22 F)) - (bcStrings (6 "0.0644" x32 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.1138" x13 F)) - (bcStrings (6 "0.1181" x23 F)) - (bcStrings (6 "0.6037" x33 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.6751" x14 F)) - (bcStrings (6 "0.7255" x24 F)) - (bcStrings (6 "0.6430" x34 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.6362" x15 F)) - (bcStrings (6 "0.8638" x25 F)) - (bcStrings (6 "0.0428" x35 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.1424" x16 F)) - (bcStrings (6 "0.8723" x26 F)) - (bcStrings (6 "0.4815" x36 F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Trignometric coefficients (not required if initial call) ") - (text . "{\it TRIG}: \newline \tab{2} ") - (bcStrings (6 "0.0" t1 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" t2 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" t3 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" t4 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" t5 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" t6 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" t7 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" t8 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" t9 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" t10 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" t11 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" t12 F)) - (text . "\blankline ")) - htMakeDoneButton('"Continue",'c06fqfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) - htpSetProperty(page,'init,init) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -c06fqfGen htPage == - n := htpProperty(htPage,'n) - m := htpProperty(htPage,'m) - init := htpProperty(htPage,'init) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - for i in 1..(2*n) repeat - left := STRCONC((first y).1," ") - y := rest y - triglist := [left,:triglist] - trigstring := bcwords2liststring triglist - while y repeat - left := STRCONC((first y).1," ") - y := rest y - xlist := [left,:xlist] - xstring := bcwords2liststring xlist - prefix := STRCONC ('"c06fqf(",STRINGIMAGE m,", ",STRINGIMAGE n,", _"") - prefix := STRCONC(prefix,init,"_",[",xstring,"],[",trigstring,"],") - linkGen STRCONC(prefix,STRINGIMAGE ifail,")") - - -c06frf() == - htInitPage('"C06FRF - Multiple 1-D complex discrete Fourier transform ",nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXc06frf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|c06frf| '|NagSeriesSummationPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "Computes the discrete Fourier transforms of {\it m} complex ") - (text . "sequences, each containing {\it n} data values.") - (text . "\blankline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "Enter the number of sequences to be transformed {\it m}: ") - (text . "\newline \tab{2} ") - (bcStrings (5 3 m PI)) - (text . "\blankline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "Enter the number of data values {\it n}: ") - (text . "\newline\tab{2} ") - (bcStrings (5 6 n PI)) - (text . "\blankline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "Type of call:") - (radioButtons init - ("" " Initial" i) - ("" " Subsequent" s) - ("" " Restart" r)) - (text . "\blankline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "Ifail value:") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'c06frfSolve) - htShowPage() - -c06frfSolve htPage == - m := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) - objValUnwrap htpLabelSpadValue(htPage, 'm) - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - call := htpButtonValue(htPage,'init) - init := - call = 'i => '"i" - call = 's => '"s" - '"r" - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - (n = '6 and m = '3) => c06frfDefaultSolve(htPage,init,ifail) - xList := - "append"/[fx(i,m) for i in 1..n] where fx(i,n) == - labelList := - "append"/[gx(i,j) for j in 1..n] where gx(i,j) == - xnam := INTERN STRCONC ('"x",STRINGIMAGE i, STRINGIMAGE j) - [['bcStrings,[6, 0.0, xnam, 'F]]] - prefix := ('"\newline \tab{2} ") - labelList := [['text,:prefix],:labelList] - yList := - "append"/[fy(i,m) for i in 1..n] where fy(i,n) == - labelList := - "append"/[gy(i,j) for j in 1..n] where gy(i,j) == - ynam := INTERN STRCONC ('"y",STRINGIMAGE i, STRINGIMAGE j) - [['bcStrings,[6, 0.0, ynam, 'F]]] - prefix := ('"\newline \tab{2} ") - labelList := [['text,:prefix],:labelList] - prefix := ('"\blankline \menuitemstyle{} \tab{2} Enter the imaginary parts ") - prefix := STRCONC(prefix,"of each sequence to be transformed, {\it y}. ") - prefix := STRCONC(prefix,"(Each column to contain the imaginary parts ") - prefix := STRCONC(prefix,"of a sequence.) \newline \tab{2} ") - yList := [['text,:prefix],:yList] - trigList := - "append"/[h(k) for k in 1..(2*n)] where h(k) == - prefix := ("\newline \tab{2} ") - trignam := INTERN STRCONC ('"t",STRINGIMAGE k) - [['text,:prefix],['bcStrings,[6, "0.0", trignam, 'F]]] - prefix := ('"\blankline \menuitemstyle{} \tab{2} Trignometric coefficients ") - prefix := STRCONC(prefix,"(not required if initial call) {\it TRIG}: ") - prefix := STRCONC(prefix,"\newline \tab{2} ") - trigList := [['text,:prefix],:trigList] - equationPart := [ - '(domainConditions - (isDomain F (Float))), - :xList,:yList,:trigList] - page := htInitPage("C06FRF - Multiple 1-D real discrete Fourier transform ", htpPropertyList htPage) - htSay '"\menuitemstyle{} \tab{2} " - htSay '"Enter the real parts of each sequence to be transformed, {\it x}. " - htSay '"(Each column to contain the real parts of a sequence.) " - htMakePage equationPart - htMakeDoneButton('"Continue",'c06frfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) - htpSetProperty(page,'init,init) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -c06frfDefaultSolve (htPage, init,ifail) == - n := '6 - m := '3 - page := htInitPage('"C06FRF - Multiple 1-D real discrete Fourier transform ",nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Enter the real parts of each sequence to be transformed, ") - (text . "{\it x}. (Each column to contain the real parts of a sequence.) ") - (text . "\newline \tab{2} ") - (bcStrings (6 "0.3854" x11 F)) - (bcStrings (6 "0.9172" x21 F)) - (bcStrings (6 "0.1156" x31 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.6772" x12 F)) - (bcStrings (6 "0.0644" x22 F)) - (bcStrings (6 "0.0685" x32 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.1138" x13 F)) - (bcStrings (6 "0.6037" x23 F)) - (bcStrings (6 "0.2060" x33 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.6751" x14 F)) - (bcStrings (6 "0.6430" x24 F)) - (bcStrings (6 "0.8630" x34 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.6362" x15 F)) - (bcStrings (6 "0.0428" x25 F)) - (bcStrings (6 "0.6967" x35 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.1424" x16 F)) - (bcStrings (6 "0.4815" x26 F)) - (bcStrings (6 "0.2792" x36 F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter the imaginary parts of each ") - (text . "sequence to be transformed, {\it y}. ") - (text . "(Each column to contain the imaginary parts of a sequence.) ") - (text . "\newline \tab{2} ") - (bcStrings (6 "0.5417" y11 F)) - (bcStrings (6 "0.9089" y21 F)) - (bcStrings (6 "0.6214" y31 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.2983" y12 F)) - (bcStrings (6 "0.3118" y22 F)) - (bcStrings (6 "0.8681" y32 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.1181" y13 F)) - (bcStrings (6 "0.3465" y23 F)) - (bcStrings (6 "0.7060" y33 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.7255" y14 F)) - (bcStrings (6 "0.6198" y24 F)) - (bcStrings (6 "0.8652" y34 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.8638" y15 F)) - (bcStrings (6 "0.2668" y25 F)) - (bcStrings (6 "0.9190" y35 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.8723" y16 F)) - (bcStrings (6 "0.1614" y26 F)) - (bcStrings (6 "0.3355" y36 F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Trignometric coefficients (not required if initial call) ") - (text . "{\it TRIG}: \newline \tab{2} ") - (bcStrings (6 "0.0" t1 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" t2 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" t3 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" t4 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" t5 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" t6 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" t7 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" t8 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" t9 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" t10 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" t11 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" t12 F)) - (text . "\blankline ")) - htMakeDoneButton('"Continue",'c06frfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) - htpSetProperty(page,'init,init) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -c06frfGen htPage == - n := htpProperty(htPage,'n) - m := htpProperty(htPage,'m) - init := htpProperty(htPage,'init) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - for i in 1..(2*n) repeat - left := STRCONC((first y).1," ") - y := rest y - triglist := [left,:triglist] - trigstring := bcwords2liststring triglist - for i in 1..(m*n) repeat - left := STRCONC((first y).1," ") - y := rest y - ylist := [left,:ylist] - ystring := bcwords2liststring ylist - while y repeat - left := STRCONC((first y).1," ") - y := rest y - xlist := [left,:xlist] - xstring := bcwords2liststring xlist - prefix := STRCONC ('"c06frf(",STRINGIMAGE m,", ",STRINGIMAGE n,", _"") - prefix := STRCONC(prefix,init,"_",[",xstring,"],[",ystring,"],[") - linkGen STRCONC(prefix,trigstring,"],",STRINGIMAGE ifail,")") - - -c06fuf() == - htInitPage('"C06FUF - 2-D complex discrete Fourier transform ",nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXc06fuf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|c06fuf| '|NagSeriesSummationPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "Computes the two-dimensional discrete Fourier transform of ") - (text . "a bivaraite sequence of complex data values; likely to be ") - (text . "efficient on vector processors. ") - (text . "\blankline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "Enter the number of {\it m} of rows of X and Y; ") - (text . "\htbitmap{great=} 1 \newline \tab{2} ") - (bcStrings (5 3 m PI)) - (text . "\blankline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "Enter the number of {\it n} of columns of X and Y; ") - (text . "\htbitmap{great=} 1 \newline \tab{2} ") - (bcStrings (5 5 n PI)) - (text . "\blankline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "Type of call:") - (radioButtons init - ("" " Initial" i) - ("" " Subsequent" s) - ("" " Restart" r)) - (text . "\blankline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "Ifail value:") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'c06fufSolve) - htShowPage() - -c06fufSolve htPage == - m := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) - objValUnwrap htpLabelSpadValue(htPage, 'm) - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - call := htpButtonValue(htPage,'init) - init := - call = 'i => '"i" - call = 's => '"s" - '"r" - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - (n = '5 and m = '3) => c06fufDefaultSolve(htPage,init,ifail) - xList := - "append"/[fx(i,m) for i in 1..n] where fx(i,n) == - labelList := - "append"/[gx(i,j) for j in 1..n] where gx(i,j) == - xnam := INTERN STRCONC ('"x",STRINGIMAGE i, STRINGIMAGE j) - [['bcStrings,[6, 0.0, xnam, 'F]]] - prefix := ('"\newline \tab{2} ") - labelList := [['text,:prefix],:labelList] - yList := - "append"/[fy(i,m) for i in 1..n] where fy(i,n) == - labelList := - "append"/[gy(i,j) for j in 1..n] where gy(i,j) == - ynam := INTERN STRCONC ('"y",STRINGIMAGE i, STRINGIMAGE j) - [['bcStrings,[6, 0.0, ynam, 'F]]] - prefix := ('"\newline \tab{2} ") - labelList := [['text,:prefix],:labelList] - prefix := ('"\blankline \menuitemstyle{} \tab{2} Enter the imaginary parts ") - prefix := STRCONC(prefix,"of each sequence to be transformed, {\it y}. ") - prefix := STRCONC(prefix,"(Each column to contain the imaginary parts ") - prefix := STRCONC(prefix,"of a sequence.) \newline \tab{2} ") - yList := [['text,:prefix],:yList] - trigmList := - "append"/[hm(k) for k in 1..(2*m)] where hm(k) == - prefix := ("\newline \tab{2} ") - trignam := INTERN STRCONC ('"tm",STRINGIMAGE k) - [['text,:prefix],['bcStrings,[6, "0.0", trignam, 'F]]] - prefix := ('"\blankline \menuitemstyle{} \tab{2} Trignometric coefficients ") - prefix := STRCONC(prefix,"(not required if initial call) {\it TRIGM}: ") - prefix := STRCONC(prefix,"\newline \tab{2} ") - trigmList := [['text,:prefix],:trigmList] - trignList := - "append"/[hn(k) for k in 1..(2*n)] where hn(k) == - prefix := ("\newline \tab{2} ") - trignam := INTERN STRCONC ('"tn",STRINGIMAGE k) - [['text,:prefix],['bcStrings,[6, "0.0", trignam, 'F]]] - prefix := ('"\blankline \menuitemstyle{} \tab{2} {\it TRIGN}: ") - prefix := STRCONC(prefix,"\newline \tab{2} ") - trignList := [['text,:prefix],:trignList] - equationPart := [ - '(domainConditions - (isDomain F (Float))), - :xList,:yList,:trigmList,:trignList] - page := htInitPage("C06FUF - 2-D complex discrete Fourier transform ", htpPropertyList htPage) - htSay '"\menuitemstyle{} \tab{2} " - htSay '"Enter the real part of each sequence to be transformed, {\it x}. " - htSay '"(Each column to contain the real parts of a sequence.) " - htMakePage equationPart - htMakeDoneButton('"Continue",'c06fufGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) - htpSetProperty(page,'init,init) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -c06fufDefaultSolve (htPage, init,ifail) == - n := '5 - m := '3 - page := htInitPage('"C06FUF - 2-D real discrete Fourier transform ",nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Enter the real parts of each sequence to be transformed, ") - (text . "{\it x}. (Each column to contain the real parts of a sequence.) ") - (text . "\newline \tab{2} ") - (bcStrings (6 "1.000" x11 F)) - (bcStrings (6 "0.994" x21 F)) - (bcStrings (6 "0.903" x31 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.999" x12 F)) - (bcStrings (6 "0.989" x22 F)) - (bcStrings (6 "0.885" x32 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.987" x13 F)) - (bcStrings (6 "0.963" x23 F)) - (bcStrings (6 "0.823" x33 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.936" x14 F)) - (bcStrings (6 "0.891" x24 F)) - (bcStrings (6 "0.694" x34 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.802" x15 F)) - (bcStrings (6 "0.731" x25 F)) - (bcStrings (6 "0.467" x35 F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter the imaginary parts of each ") - (text . "sequence to be transformed, {\it y}. (Each column to contain ") - (text . "the imaginary parts of a sequence.) ") - (text . "\newline \tab{2} ") - (bcStrings (6 "0.000" y11 F)) - (bcStrings (6 "-0.111" y21 F)) - (bcStrings (6 "-0.430" y31 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "-0.040" y12 F)) - (bcStrings (6 "-0.151" y22 F)) - (bcStrings (6 "-0.466" y32 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "-0.159" y13 F)) - (bcStrings (6 "-0.268" y23 F)) - (bcStrings (6 "-0.568" y33 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "-0.352" y14 F)) - (bcStrings (6 "-0.454" y24 F)) - (bcStrings (6 "-0.720" y34 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "-0.597" y15 F)) - (bcStrings (6 "-0.682" y25 F)) - (bcStrings (6 "-0.884" y35 F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Trignometric coefficients (not required if initial call) ") - (text . "{\it TRIGM}: \newline \tab{2} ") - (bcStrings (6 "0.0" tm1 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" tm2 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" tm3 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" tm4 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" tm5 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" tm6 F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "{\it TRIGN}: \newline \tab{2} ") - (bcStrings (6 "0.0" tn1 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" tn2 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" tn3 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" tn4 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" tn5 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" tn6 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" tn7 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" tn8 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" tn9 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" tn10 F)) - (text . "\blankline ")) - htMakeDoneButton('"Continue",'c06fufGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) - htpSetProperty(page,'init,init) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -c06fufGen htPage == - n := htpProperty(htPage,'n) - m := htpProperty(htPage,'m) - init := htpProperty(htPage,'init) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - for i in 1..(2*n) repeat - left := STRCONC((first y).1," ") - y := rest y - trignlist := [left,:trignlist] - trignstring := bcwords2liststring trignlist - for i in 1..(2*m) repeat - left := STRCONC((first y).1," ") - y := rest y - trigmlist := [left,:trigmlist] - trigmstring := bcwords2liststring trigmlist - for i in 1..(m*n) repeat - left := STRCONC((first y).1," ") - y := rest y - ylist := [left,:ylist] - ystring := bcwords2liststring ylist - while y repeat - left := STRCONC((first y).1," ") - y := rest y - xlist := [left,:xlist] - xstring := bcwords2liststring xlist - prefix := STRCONC ('"c06fuf(",STRINGIMAGE m,", ",STRINGIMAGE n,", _"") - prefix := STRCONC(prefix,init,"_",[",xstring,"],[",ystring,"],[",trigmstring) - linkGen STRCONC(prefix,"],[",trignstring,"],",STRINGIMAGE ifail,")") - - - -c06gbf() == - htInitPage('"C06GBF - Complex conjugate of a Hermitian sequence ",nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXc06gbf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|c06gbf| '|NagSeriesSummationPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "Forms the complex conjugate of a Hermitian sequence of {\it n} data values") - (text . "\newline ") - (text . "\blankline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "Enter the number of data values {\it n} ") - (text . "\space{1} \inputbitmap{\htbmdir{}/great=.bitmap} 1 ") - (text . "\newline\tab{2} ") - (bcStrings (5 7 n PI)) - (text . "\blankline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "Ifail value:") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'c06gbfSolve) - htShowPage() - -c06gbfSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - n = '7 => c06gbfDefaultSolve(htPage,ifail) - labelList := - "append"/[f(i) for i in 1..n] where f(i) == - prefix := ('"\newline \tab{15} ") - rnam := INTERN STRCONC ('"r",STRINGIMAGE i) - [['text,:prefix],['bcStrings,[10, 0.0, rnam, 'F]]] - equationPart := [ - '(domainConditions - (isDomain F (Float))), - :labelList] - page := htInitPage("C06GBF - Complex conjugate of a Hermitian sequence ", htpPropertyList htPage) - htSay '"\menuitemstyle{} \tab{2} " - htSay '"Enter the Hermitian sequence to be transformed stored in Hermitian form: " - htMakePage equationPart - htSay '"\blankline " - htSay '"Note : On exit, the imaginary values are negated " - htSay '"\blankline " - htMakeDoneButton('"Continue",'c06gbfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -c06gbfDefaultSolve (htPage, ifail) == - n := '7 - page := htInitPage('"C06GBF - Complex conjugate of a Hermitian sequence ", nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Enter the Hermitian sequence to be transformed ") - (text . "stored in Hermitian form: ") - (text . "\newline \tab{15} ") - (bcStrings (10 "0.34907" r1 F)) - (text . "\newline \tab{15} ") - (bcStrings (10 "0.54890" r2 F)) - (text . "\newline \tab{15} ") - (bcStrings (10 "0.74776" r3 F)) - (text . "\newline \tab{15} ") - (bcStrings (10 "0.94459" r4 F)) - (text . "\newline \tab{15} ") - (bcStrings (10 "1.13850" r5 F)) - (text . "\newline \tab{15} ") - (bcStrings (10 "1.32850" r6 F)) - (text . "\newline \tab{15} ") - (bcStrings (10 "1.51370" r7 F)) - (text . "\blankline ") - (text . "Note : On exit, the imaginary values are negated ") - (text . "\blankline ")) - htMakeDoneButton('"Continue",'c06gbfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -c06gbfGen htPage == - n := htpProperty(htPage,'n) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - while y repeat - left := STRCONC((first y).1," ") - y := rest y - reallist := [left,:reallist] - realstring := bcwords2liststring reallist - linkGen STRCONC ('"c06gbf(",STRINGIMAGE n,",[",realstring,"],",STRINGIMAGE ifail,")") - - -c06gcf() == - htInitPage('"C06GCF - Complex conjugate of complex sequence ",nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXc06gcf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|c06gcf| '|NagSeriesSummationPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "Forms the complex conjugate of a sequence of {\it n} data values") - (text . "\newline ") - (text . "\blankline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "Enter the number of data values {\it n} ") - (text . "\space{1} \inputbitmap{\htbmdir{}/great=.bitmap} 1 ") - (text . "\newline\tab{2} ") - (bcStrings (5 7 n PI)) - (text . "\blankline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "Ifail value:") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'c06gcfSolve) - htShowPage() - -c06gcfSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - n = '7 => c06gcfDefaultSolve(htPage,ifail) - labelList := - "append"/[f(i) for i in 1..n] where f(i) == - prefix := ('"\newline \tab{15} ") - rnam := INTERN STRCONC ('"r",STRINGIMAGE i) - [['text,:prefix],['bcStrings,[10, 0.0, rnam, 'F]]] - equationPart := [ - '(domainConditions - (isDomain F (Float))), - :labelList] - page := htInitPage("C06GCF - Complex conjugate of a Hermitian sequence ", htpPropertyList htPage) - htSay '"\menuitemstyle{} \tab{2} " - htSay '"Enter the imaginary parts of the sequence: " - htMakePage equationPart - htSay '"\blankline " - htSay '"Note : On exit, these values are negated " - htSay '"\blankline " - htMakeDoneButton('"Continue",'c06gcfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -c06gcfDefaultSolve (htPage, ifail) == - n := '7 - page := htInitPage('"C06GCF - Complex conjugate of complex sequence ", nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Enter the imaginary parts of the sequence: ") - (text . "\newline \tab{15} ") - (bcStrings (10 "-0.37168" r1 F)) - (text . "\newline \tab{15} ") - (bcStrings (10 "-0.35669" r2 F)) - (text . "\newline \tab{15} ") - (bcStrings (10 "-0.31175" r3 F)) - (text . "\newline \tab{15} ") - (bcStrings (10 "-0.23702" r4 F)) - (text . "\newline \tab{15} ") - (bcStrings (10 "0.00074" r5 F)) - (text . "\newline \tab{15} ") - (bcStrings (10 "0.16298" r6 F)) - (text . "\newline \tab{15} ") - (bcStrings (10 "1.51370" r7 F)) - (text . "\blankline ") - (text . "Note : On exit, these values are negated ") - (text . "\blankline ")) - htMakeDoneButton('"Continue",'c06gcfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -c06gcfGen htPage == - n := htpProperty(htPage,'n) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - while y repeat - left := STRCONC((first y).1," ") - y := rest y - reallist := [left,:reallist] - realstring := bcwords2liststring reallist - linkGen STRCONC ('"c06gcf(",STRINGIMAGE n,",[",realstring,"],",STRINGIMAGE ifail,")") - -c06gqf() == - htInitPage('"C06GQF - Complex conjugate of multiple Hermitian sequences ",nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXc06gqf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|c06gqf| '|NagSeriesSummationPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "Forms the complex conjugates of {\it m} Hermitian sequences, ") - (text . "each containing {\it n} data values. ") - (text . "\newline ") - (text . "\blankline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "Enter the number {\it m} \inputbitmap{\htbmdir{}/great=.bitmap} 1 ") - (text . "of sequences to be tranformed: ") - (text . "\newline\tab{2} ") - (bcStrings (5 3 m PI)) - (text . "\blankline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "Enter the number {\it n} \inputbitmap{\htbmdir{}/great=.bitmap} 1 ") - (text . "of data values in each sequence: ") - (text . "\newline\tab{2} ") - (bcStrings (5 6 n PI)) - (text . "\blankline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "Ifail value:") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'c06gqfSolve) - htShowPage() - - -c06gqfSolve htPage == - m := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) - objValUnwrap htpLabelSpadValue(htPage, 'm) - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - (m = '3 and n = '6) => c06gqfDefaultSolve(htPage,ifail) - newList:= - "append"/[g(i,m) for i in 1..n] where g(i,n) == - labelList := - "append"/[f(i,j) for j in 1..n] where f(i,j) == - rnam := INTERN STRCONC ('"r",STRINGIMAGE i,STRINGIMAGE j) - [['bcStrings,[6, 0.0, rnam, 'P]]] - prefix := ('"\newline \tab{2} ") - labelList := [['text,:prefix],:labelList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :newList] - page := htInitPage("C06GQF - Complex conjugate of multiple Hermitian sequences ",htpPropertyList htPage) - htSay '"\newline " - htSay '"\menuitemstyle{}\tab{2} Please enter each sequence to be " - htSay '"transformed in Hermitian format. (Each column to contain " - htSay '"a sequence.) " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'c06gqfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -c06gqfDefaultSolve (htPage, ifail) == - m := '3 - n := '6 - page := htInitPage('"C06GQF - Complex conjugate of multiple Hermitian sequences ",htpPropertyList htPage) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Please enter each sequence to be ") - (text . "transformed in Hermitian format. ") - (text . "(Each column to contain a sequence.) ") - (text . "\newline \tab{2} ") - (bcStrings (6 "0.3854" x11 F)) - (bcStrings (6 "0.5417" x21 F)) - (bcStrings (6 "0.9172" x31 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.6772" x12 F)) - (bcStrings (6 "0.2983" x22 F)) - (bcStrings (6 "0.0644" x32 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.1138" x13 F)) - (bcStrings (6 "0.1181" x23 F)) - (bcStrings (6 "0.6037" x33 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.6751" x14 F)) - (bcStrings (6 "0.7255" x24 F)) - (bcStrings (6 "0.6430" x34 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.6362" x15 F)) - (bcStrings (6 "0.8638" x25 F)) - (bcStrings (6 "0.0428" x35 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.1424" x16 F)) - (bcStrings (6 "0.8723" y26 F)) - (bcStrings (6 "0.4815" y36 F)) - (text . "\blankline")) - htMakeDoneButton('"Continue",'c06gqfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -c06gqfGen htPage == - n := htpProperty(htPage,'n) - m := htpProperty(htPage,'m) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - while y repeat - right := STRCONC ((first y).1," ") - y := rest y - reallist := [right,:reallist] - realstring := bcwords2liststring reallist - linkGen STRCONC ('"c06gqf(",STRINGIMAGE m,",",STRINGIMAGE n,",[",realstring,"],", STRINGIMAGE ifail,")") - - - -c06gsf() == - htInitPage('"C06GSF - Convert Hermitian sequences to general complex sequences", nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXc06gsf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|c06gsf| '|NagSeriesSummationPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "Takes {\it m} Hermitian sequences, each containing {\it n} data values, ") - (text . "and forms the real and imaginary parts of the {\it m} ") - (text . "corresponding complex sequences. \newline ") - (text . "\blankline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "Enter the number {\it m} \inputbitmap{\htbmdir{}/great=.bitmap} 1 ") - (text . "of sequences to be transformed: ") - (text . "\newline\tab{2} ") - (bcStrings (5 3 m PI)) - (text . "\blankline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "Enter the number {\it n} \inputbitmap{\htbmdir{}/great=.bitmap} 1 ") - (text . "of data values in each sequence: ") - (text . "\newline\tab{2} ") - (bcStrings (5 6 n PI)) - (text . "\blankline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "Ifail value:") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'c06gsfSolve) - htShowPage() - - -c06gsfSolve htPage == - m := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) - objValUnwrap htpLabelSpadValue(htPage, 'm) - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - (m = '3 and n = '6) => c06gsfDefaultSolve(htPage,ifail) - newList:= - "append"/[g(i,m) for i in 1..n] where g(i,n) == - labelList := - "append"/[f(i,j) for j in 1..n] where f(i,j) == - rnam := INTERN STRCONC ('"r",STRINGIMAGE i,STRINGIMAGE j) - [['bcStrings,[6, 0.0, rnam, 'P]]] - prefix := ('"\newline \tab{2} ") - labelList := [['text,:prefix],:labelList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :newList] - page := htInitPage("C06GSF - Convert Hermitian sequences to general complex sequences ",htpPropertyList htPage) - htSay '"\newline " - htSay '"\menuitemstyle{}\tab{2} Please enter each sequence to be " - htSay '"transformed in Hermitian format. (Each column to contain a " - htSay '"sequence.) " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'c06gsfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -c06gsfDefaultSolve (htPage, ifail) == - m := '3 - n := '6 - page := htInitPage('"C06GSF - Convert Hermitian sequences to general complex sequences ",htpPropertyList htPage) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Please enter each sequence to be ") - (text . "transformed in Hermitian format. (Each column to contain a ") - (text . "sequence.) ") - (text . "\newline \tab{2} ") - (bcStrings (6 "0.3854" x11 F)) - (bcStrings (6 "0.5417" x21 F)) - (bcStrings (6 "0.9172" x31 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.6772" x12 F)) - (bcStrings (6 "0.2983" x22 F)) - (bcStrings (6 "0.0644" x32 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.1138" x13 F)) - (bcStrings (6 "0.1181" x23 F)) - (bcStrings (6 "0.6037" x33 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.6751" x14 F)) - (bcStrings (6 "0.7255" x24 F)) - (bcStrings (6 "0.6430" x34 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.6362" x15 F)) - (bcStrings (6 "0.8638" x25 F)) - (bcStrings (6 "0.0428" x35 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.1424" x16 F)) - (bcStrings (6 "0.8723" y26 F)) - (bcStrings (6 "0.4815" y36 F)) - (text . "\blankline")) - htMakeDoneButton('"Continue",'c06gsfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -c06gsfGen htPage == - n := htpProperty(htPage,'n) - m := htpProperty(htPage,'m) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - while y repeat - right := STRCONC ((first y).1," ") - y := rest y - reallist := [right,:reallist] - realstring := bcwords2liststring reallist - linkGen STRCONC ('"c06gsf(",STRINGIMAGE m,",",STRINGIMAGE n,",[",realstring,"],", STRINGIMAGE ifail,")") - - -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/nag-d01.boot b/src/interp/nag-d01.boot new file mode 100644 index 00000000..9d85ecff --- /dev/null +++ b/src/interp/nag-d01.boot @@ -0,0 +1,1339 @@ +-- 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. + + +)package "BOOT" + +d01ajf() == + htInitPage('"D01AJF - 1-D quadrature, adaptive, finite interval, allowing for badly-behaved integrands", nil) + htMakePage '( + (domainConditions + (isDomain EM $EmptyMode) + (isDomain PI (PositiveInteger)) + (isDomain F (Float))) + (text . "\windowlink{Manual Page}{manpageXXd01ajf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d01ajf| '|NagIntegrationPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "Evaluates the integral ") + (text . "\inputbitmap{\htbmdir{}/integral.bitmap} f(x) dx ") + (text . "using an adaptive method. ") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Enter the {\em function} f to be integrated in terms of X: ") + (text . "\newline \tab{2} ") + (bcStrings (55 "X*sin(30*X)/(sqrt(1-(X/(2*\%pi))**2))" expression EM)) + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} ") + (text . "\newline {\em Lower} bound of the interval: ") + (text . "\tab{32} \menuitemstyle{}\tab{34} ") + (text . "{\em Upper} bound:") + (text . "\newline\tab{2} ") + (bcStrings (20 "0.0" a F)) + (text . "\tab{34} ") + (bcStrings (20 "\%pi*2" b EM)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "\newline Absolute accuracy required:") + (text . "\tab{32} \menuitemstyle{}\tab{34}") + (text . "Relative accuracy:") + (text . "\newline\tab{2} ") + (bcStrings (10 "0.0" epsabs F)) + (text . "\tab{34} ") + (bcStrings (10 "1.0e-4" epsrel F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Dimension of workspace array: ") + (text . "\newline\tab{2} ") + (bcStrings (10 800 lw 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", 'd01ajfGen) + htShowPage() + +d01ajfGen htPage == + lw := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lw) + objValUnwrap htpLabelSpadValue(htPage, 'lw) + a := htpLabelInputString(htPage,'a) + b := htpLabelInputString(htPage,'b) + epsabs := htpLabelInputString(htPage,'epsabs) + epsrel := htpLabelInputString(htPage,'epsrel) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => 1 + -1 + express := htpLabelInputString(htPage,'expression) + liw := lw/4 + prefix := STRCONC("d01ajf(",a," ,",b," ,",epsabs," ,",epsrel," ,",STRINGIMAGE lw) + middle := STRCONC(" ,",STRINGIMAGE liw," ,",STRINGIMAGE ifail," ,") + end := STRCONC("(",express,"::Expression Float) :: ASP1(F))") + linkGen STRCONC(prefix,middle,end) + +d01akf() == + htInitPage('"D01AKF - 1-D quadrature, adaptive, finite interval, method suitable for oscillating functions", nil) + htMakePage '( + (domainConditions + (isDomain EM $EmptyMode) + (isDomain PI (PositiveInteger)) + (isDomain F (Float))) + (text . "\windowlink{Manual Page}{manpageXXd01akf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d01akf| '|NagIntegrationPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "Computes \space{1} \inputbitmap{\htbmdir{}/integral.bitmap} ") + (text . "f(x) dx using an adaptive method, ") + (text . "especially suited to oscillating, non-singular integrands. ") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Enter the {\em function} f to be integrated in terms of X: ") + (text . "\newline \tab{2} ") + (bcStrings (55 "X*sin(30*X)*cos(X)" expression EM)) + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} ") + (text . "\newline {\em Lower} bound of the interval: ") + (text . "\tab{32} \menuitemstyle{}\tab{34} ") + (text . "{\em Upper} bound:") + (text . "\newline\tab{2} ") + (bcStrings (20 "0.0" a F)) + (text . "\tab{34} ") + (bcStrings (20 "\%pi*2" b EM)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "\newline Absolute accuracy required:") + (text . "\tab{32} \menuitemstyle{}\tab{34}") + (text . "Relative accuracy:") + (text . "\newline\tab{2} ") + (bcStrings (10 "0.0" epsabs F)) + (text . "\tab{34} ") + (bcStrings (10 "1.0e-4" epsrel F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Dimension of workspace array: ") + (text . "\newline\tab{2} ") + (bcStrings (10 800 lw 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", 'd01akfGen) + htShowPage() + +d01akfGen htPage == + lw := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lw) + objValUnwrap htpLabelSpadValue(htPage, 'lw) + a := htpLabelInputString(htPage,'a) + b := htpLabelInputString(htPage,'b) + epsabs := htpLabelInputString(htPage,'epsabs) + epsrel := htpLabelInputString(htPage,'epsrel) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => 1 + -1 + express := htpLabelInputString(htPage,'expression) + liw := lw/4 + prefix := STRCONC("d01akf(",a," ,",b," ,",epsabs," ,",epsrel," ,",STRINGIMAGE lw) + middle := STRCONC(" ,",STRINGIMAGE liw," ,",STRINGIMAGE ifail," ,") + end := STRCONC("(",express,"::Expression Float) :: ASP1(F))") + linkGen STRCONC(prefix,middle,end) + +d01alf() == + htInitPage('"D01ALF - 1-D quadrature, adaptive, finite interval, allowing for singularities at user-specified break-points ", nil) + htMakePage '( + (domainConditions + (isDomain EM $EmptyMode) + (isDomain PI (PositiveInteger)) + (isDomain F (Float))) + (text . "\windowlink{Manual Page}{manpageXXd01alf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d01alf| '|NagIntegrationPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "Evaluates the integral \space{1} ") + (text . "\inputbitmap{\htbmdir{}/integral.bitmap} f(x) dx; ") + (text . "the integrand may have local singular behaviour at a ") + (text . "finite number of points within [a,b]. ") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Enter the {\em function} f to be integrated in terms of X: ") + (text . "\newline \tab{2} ") + (bcStrings (55 "1/sqrt(abs(X-1/7))" expression EM)) + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} ") + (text . "\newline {\em Lower} bound of the interval: ") + (text . "\tab{32} \menuitemstyle{}\tab{34} ") + (text . "{\em Upper} bound:") + (text . "\newline\tab{2} ") + (bcStrings (20 "0.0" a F)) + (text . "\tab{34} ") + (bcStrings (20 "1.0" b EM)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "\newline Number of user supplied break-points: \tab{38}") + (bcStrings (10 "1" npts PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "\newline User supplied break-points (separated by commas): ") + (text . "\newline \tab{2} ") + (bcStrings (40 "1/7" points EM)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "\newline Absolute accuracy required:") + (text . "\tab{32} \menuitemstyle{}\tab{34}") + (text . "Relative accuracy:") + (text . "\newline\tab{2} ") + (bcStrings (10 "0.0" epsabs F)) + (text . "\tab{34} ") + (bcStrings (10 "1.0e-4" epsrel F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Dimension of workspace array: ") + (text . "\newline\tab{2} ") + (bcStrings (10 800 lw 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", 'd01alfGen) + htShowPage() + +d01alfGen htPage == + lw := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lw) + objValUnwrap htpLabelSpadValue(htPage, 'lw) + a := htpLabelInputString(htPage,'a) + b := htpLabelInputString(htPage,'b) + npts := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'npts) + objValUnwrap htpLabelSpadValue(htPage, 'npts) + points := htpLabelInputString(htPage, 'points) + points := STRCONC ('"[[",points,"]]") + epsabs := htpLabelInputString(htPage,'epsabs) + epsrel := htpLabelInputString(htPage,'epsrel) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => 1 + -1 + express := htpLabelInputString(htPage,'expression) + liw := lw/2 + prefix := STRCONC('"d01alf(",a," ,",b," ,",STRINGIMAGE npts,",",points,",") + prefix := STRCONC(prefix,epsabs," ,",epsrel," ,",STRINGIMAGE lw) + middle := STRCONC('" ,",STRINGIMAGE liw," ,",STRINGIMAGE ifail," ,") + end := STRCONC('"(",express,"::Expression Float) :: ASP1(F))") + linkGen STRCONC(prefix,middle,end) + +d01amf() == + htInitPage('"D01AMF 1-D quadrature, adaptive, infinite or semi-infinite interval",nil) + htMakePage '( + (domainConditions + (isDomain EM $EmptyMode) + (isDomain PI (PositiveInteger)) + (isDomain F (Float))) + (text . "\windowlink{Manual Page}{manpageXXd01amf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d01amf| '|NagIntegrationPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\newline ") + (text . "Evaluates the integral \space{1} ") + (text . "\inputbitmap{\htbmdir{}/integral.bitmap} f(x) dx, ") + (text . "where (a,b) can be an infinite or semi-infinite interval.") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Enter the {\em function} f to be integrated in terms of X: ") + (text . "\newline \tab{2} ") + (bcStrings (55 "1/((X+1)*sqrt(X))" expression EM)) + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} ") + (text . "\newline {\em Bound} the finite limit of the integration range: ") + (text . "\newline\tab{2} ") + (bcStrings (10 "0.0" a F)) + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} ") + (text . "\newline Choose the kind of integration range: ") + (radioButtons inf + (" 1" "\tab{2} Range is [Bound, +infinity] " plus) + ("-1" "\tab{2} Range is [-infinity, Bound] " minus) + ("2" "\tab{2} Range is [-infinity, +infinity] (Bound is not used) " minusPlus)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "\newline Absolute accuracy required:") + (text . "\tab{32} \menuitemstyle{}\tab{34}") + (text . "Relative accuracy:") + (text . "\newline\tab{2} ") + (bcStrings (10 "0.0" epsabs F)) + (text . "\tab{34} ") + (bcStrings (10 "1.0e-4" epsrel F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Dimension of workspace array: ") + (text . "\newline\tab{2} ") + (bcStrings (10 800 lw 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", 'd01amfGen) + htShowPage() + +d01amfGen htPage == + lw := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lw) + objValUnwrap htpLabelSpadValue(htPage, 'lw) + a := htpLabelInputString(htPage,'a) + b := htpLabelInputString(htPage,'b) + infinity := htpButtonValue(htPage,'inf) + inf := + infinity = 'plus => 1 + infinity = 'minus => -1 + 2 + epsabs := htpLabelInputString(htPage,'epsabs) + epsrel := htpLabelInputString(htPage,'epsrel) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => 1 + -1 + express := htpLabelInputString(htPage,'expression) + liw := lw/4 + prefix := STRCONC('"d01amf(",a," ,",STRINGIMAGE inf," ,") + prefix := STRCONC(prefix,epsabs," ,",epsrel," ,",STRINGIMAGE lw) + middle := STRCONC('" ,",STRINGIMAGE liw," ,",STRINGIMAGE ifail," ,") + end := STRCONC('"(",express,"::Expression Float) :: ASP1(F))") + linkGen STRCONC(prefix,middle,end) + +d01anf() == + htInitPage('"D01ANF - 1-D quadrature, adaptive, finite interval, weight function cos(\omega x) or sin(\omega x)", nil) + htMakePage '( + (domainConditions + (isDomain EM $EmptyMode) + (isDomain PI (PositiveInteger)) + (isDomain F (Float))) + (text . "\windowlink{Manual Page}{manpageXXd01anf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d01anf| '|NagIntegrationPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "Evaluates \inputbitmap{\htbmdir{}/integral.bitmap} g(x)sin(\omega x) dx ") + (text . "or \inputbitmap{\htbmdir{}/integral.bitmap} g(x)cos(\omega x) dx, ") + (text . "the sine and cosine transform respectively. ") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Enter the {\em function} f to be integrated in terms of X: ") + (text . "\newline \tab{2} ") + (bcStrings (55 "log(X)" expression EM)) + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} ") + (text . "\newline {\em Lower} bound of the interval: ") + (text . "\tab{32} \menuitemstyle{}\tab{34} ") + (text . "{\em Upper} bound:") + (text . "\newline\tab{2} ") + (bcStrings (20 "1.0e-6" a F)) + (text . "\tab{34} ") + (bcStrings (20 "1.0" b EM)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "\newline Absolute accuracy required:") + (text . "\tab{32} \menuitemstyle{}\tab{34}") + (text . "Relative accuracy:") + (text . "\newline\tab{2} ") + (bcStrings (10 "0.0" epsabs F)) + (text . "\tab{34} ") + (bcStrings (10 "1.0e-4" epsrel F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Dimension of workspace: ") + (text . "\tab{32} \menuitemstyle{}\tab{34}") + (text . "\omega the weight function:") + (text . "\newline\tab{2} ") + (bcStrings (10 800 lw PI)) + (text . "\tab{34} ") + (bcStrings (20 "10*\%pi" omega F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Key value, indicates which integral is to be computed:") + (radioButtons key + ("" " sin" sin) + ("" " cos" cos)) + (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", 'd01anfGen) + htShowPage() + +d01anfGen htPage == + lw := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lw) + objValUnwrap htpLabelSpadValue(htPage, 'lw) + a := htpLabelInputString(htPage,'a) + b := htpLabelInputString(htPage,'b) + epsabs := htpLabelInputString(htPage,'epsabs) + epsrel := htpLabelInputString(htPage,'epsrel) + omega := htpLabelInputString(htPage,'omega) + type := htpButtonValue(htPage,'key) + key := + type = 'cos => 1 + 2 + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => 1 + -1 + express := htpLabelInputString(htPage,'expression) + liw := lw/4 + prefix := STRCONC("d01anf(",a," ,",b," ,",omega," ,",STRINGIMAGE key," ,",epsabs," ,",epsrel," ,",STRINGIMAGE lw) + middle := STRCONC(" ,",STRINGIMAGE liw," ,",STRINGIMAGE ifail," ,") + end := STRCONC("(",express,"::Expression Float) :: ASP1(G))") + linkGen STRCONC(prefix,middle,end) + +d01apf() == + htInitPage('"D01APF - 1-D quadrature, adaptive, finite interval, weight function with end point singularities of algebraico-logarithmic type", nil) + htMakePage '( + (domainConditions + (isDomain EM $EmptyMode) + (isDomain PI (PositiveInteger)) + (isDomain F (Float))) + (text . "\windowlink{Manual Page}{manpageXXd01apf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d01apf| '|NagIntegrationPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "Evaluates \inputbitmap{\htbmdir{}/integral.bitmap} g(x)w(x) dx, where w(x) ") + (text . "has end-point singularities of algebraico-logarithmic type. ") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Enter the {\em function} g(x) in terms of X: ") + (text . "\newline \tab{2} ") + (bcStrings (55 "sin(10*X)" expression EM)) + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} ") + (text . "\newline {\em Lower} bound of the interval: ") + (text . "\tab{32} \menuitemstyle{}\tab{34} ") + (text . "{\em Upper} bound:") + (text . "\newline\tab{2} ") + (bcStrings (20 "1.0e-6" a F)) + (text . "\tab{34} ") + (bcStrings (20 "1.0" b EM)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "\newline \alpha in the weight function:") + (text . "\tab{32} \menuitemstyle{}\tab{34}") + (text . "\beta in the weight function:") + (text . "\newline\tab{2} ") + (bcStrings (10 "-0.5" alpha F)) + (text . "\tab{34} ") + (bcStrings (10 "-0.5" beta F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "\newline Absolute accuracy required:") + (text . "\tab{32} \menuitemstyle{}\tab{34}") + (text . "Relative accuracy:") + (text . "\newline\tab{2} ") + (bcStrings (10 "0.0" epsabs F)) + (text . "\tab{34} ") + (bcStrings (10 "1.0e-4" epsrel F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Dimension of workspace: ") + (text . "\newline\tab{2} ") + (bcStrings (10 800 lw PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Key value, indicates which weight function is to be used: ") + (radioButtons key + ("" "\space{1}w(x) = (x-a)**\alpha\space{1}* (b-x)**\beta" kone) + ("" "\space{1}w(x) = (x-a)**\alpha\space{1}* (b-x)**\beta * ln(x-a)" ktwo) + ("" "\space{1}w(x) = (x-a)**\alpha\space{1}* (b-x)**\beta * ln(b-x)" kthree) + ("" "\space{1}w(x) = (x-a)**\alpha\space{1}* (b-x)**\beta * ln(x-a) * ln(b-x) " kfour)) + (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", 'd01apfGen) + htShowPage() + +d01apfGen htPage == + express := htpLabelInputString(htPage,'expression) + lw := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lw) + objValUnwrap htpLabelSpadValue(htPage, 'lw) + a := htpLabelInputString(htPage,'a) + b := htpLabelInputString(htPage,'b) + alpha := htpLabelInputString(htPage,'alpha) + beta := htpLabelInputString(htPage,'beta) + epsabs := htpLabelInputString(htPage,'epsabs) + epsrel := htpLabelInputString(htPage,'epsrel) + type := htpButtonValue(htPage,'key) + key := + type = 'kone => 1 + type = 'ktwo => 2 + type = 'kthree => 3 + 4 + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => 1 + -1 + liw := lw/4 + prefix := STRCONC("d01apf(",a," ,",b," ,",alpha," ,",beta," ,") + prefix := STRCONC(prefix,STRINGIMAGE key," ,",epsabs," ,",epsrel," ,") + prefix := STRCONC(prefix,STRINGIMAGE lw," ,",STRINGIMAGE liw," ,") + end := STRCONC("(",express,"::Expression Float) :: ASP1(G))") + linkGen STRCONC(prefix,STRINGIMAGE ifail," ,",end) + +d01aqf() == + htInitPage('"D01AQF - 1-D quadrature, adaptive, finite interval, weight function 1/(x-c), Cauchy principal value (Hilbert transform)",nil) + htMakePage '( + (domainConditions + (isDomain EM $EmptyMode) + (isDomain PI (PositiveInteger)) + (isDomain F (Float))) + (text . "\windowlink{Manual Page}{manpageXXd01aqf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d01aqf| '|NagIntegrationPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "Evaluates the Hilbert transform \inputbitmap{\htbmdir{}/integral.bitmap}") + (text . "g(x)/(x-c) dx.") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Enter the function {\it g(x)} in terms of X: ") + (text . "\newline \tab{2} ") + (bcStrings (55 "(X**2+0.01**2)**-1" expression EM)) + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} ") + (text . "\newline {\em Lower} bound of the interval {\it a}: ") + (text . "\tab{32} \menuitemstyle{}\tab{34} ") + (text . "{\em Upper} bound {\it b}:") + (text . "\newline\tab{2} ") + (bcStrings (20 "-1.0" a F)) + (text . "\tab{34} ") + (bcStrings (20 "1.0" b F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} \newline ") + (text . "Parameter {\it c} \notequal {\it a} or {\it b}: ") + (text . "\newline \tab{2} ") + (bcStrings (10 "0.5" c F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "\newline Absolute accuracy required:") + (text . "\tab{32} \menuitemstyle{}\tab{34}") + (text . "Relative accuracy:") + (text . "\newline\tab{2} ") + (bcStrings (10 "0.0" epsabs F)) + (text . "\tab{34} ") + (bcStrings (10 "1.0e-4" epsrel F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Dimension of workspace: ") + (text . "\newline\tab{2} ") + (bcStrings (10 800 lw 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", 'd01aqfGen) + htShowPage() + +d01aqfGen htPage == + express := htpLabelInputString(htPage,'expression) + lw := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lw) + objValUnwrap htpLabelSpadValue(htPage, 'lw) + a := htpLabelInputString(htPage,'a) + b := htpLabelInputString(htPage,'b) + c := htpLabelInputString(htPage,'c) + epsabs := htpLabelInputString(htPage,'epsabs) + epsrel := htpLabelInputString(htPage,'epsrel) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => 1 + -1 + liw := lw/4 + prefix := STRCONC("d01aqf(",a," ,",b," ,",c," ,",epsabs," ,",epsrel," ,") + prefix := STRCONC(prefix,STRINGIMAGE lw," ,",STRINGIMAGE liw," ,") + end := STRCONC("((",express,")::Expression Float) :: ASP1(G))") + linkGen STRCONC(prefix,STRINGIMAGE ifail," ,",end) + +d01asf() == + htInitPage('"D01ASF - 1-D quadrature, adaptive, semi-infinite interval, weight function cos(\omega x) or sin(\omega x)", nil) + htMakePage '( + (domainConditions + (isDomain EM $EmptyMode) + (isDomain PI (PositiveInteger)) + (isDomain F (Float))) + (text . "\windowlink{Manual Page}{manpageXXd01asf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d01asf| '|NagIntegrationPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "Evaluates \inputbitmap{\htbmdir{}/si-integral.bitmap} ") + (text . "g(x)sin(\omega x) dx ") + (text . "or \inputbitmap{\htbmdir{}/si-integral.bitmap} ") + (text . "g(x)cos(\omega x) dx, ") + (text . "the sine and cosine transform respectively. ") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Enter the function {\it g(x)} in terms of X: ") + (text . "\newline \tab{2} ") + (bcStrings (45 "1/sqrt(X)" expression EM)) + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} ") + (text . "\newline {\em Lower} bound of the interval: ") + (text . "\newline \tab{2} ") + (bcStrings (10 "1.0e-12" a F)) + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} ") + (text . "Parameter \omega in the weight function of the transform: ") + (text . "\newline \tab{2} ") + (bcStrings (10 "\%pi/2" omega F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "\newline Absolute accuracy required:") + (text . "\newline\tab{2} ") + (bcStrings (10 "1.0e-3" epsabs F)) + (text . "\newline \menuitemstyle{}\tab{2}") + (text . "Dimension of workspace array: ") + (text . "\newline\tab{2} ") + (bcStrings (10 800 lw PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "{\it LIMLST} upper bound on number of intervals:") + (text . "\newline\tab{2} ") + (bcStrings (10 50 limlst PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Key value, indicates which integral is to be computed:") + (radioButtons key + ("" " cos(\omega x)" cos) + ("" " sin(\omega x)" sin)) + (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", 'd01asfGen) + htShowPage() + +d01asfGen htPage == + lw := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lw) + objValUnwrap htpLabelSpadValue(htPage, 'lw) + limlst := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'limlst) + objValUnwrap htpLabelSpadValue(htPage, 'limlst) + a := htpLabelInputString(htPage,'a) + epsabs := htpLabelInputString(htPage,'epsabs) + omega := htpLabelInputString(htPage,'omega) + type := htpButtonValue(htPage,'key) + key := + type = 'cos => 1 + 2 + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => 1 + -1 + express := htpLabelInputString(htPage,'expression) + liw := lw/2 + prefix := STRCONC("d01asf(",a," ,",omega," ,",STRINGIMAGE key," ,",epsabs) + prefix := STRCONC(prefix," ,",STRINGIMAGE limlst," ,",STRINGIMAGE lw) + middle := STRCONC(" ,",STRINGIMAGE liw," ,",STRINGIMAGE ifail," ,") + end := STRCONC("(",express,"::Expression Float) :: ASP1(G))") + linkGen STRCONC(prefix,middle,end) + + + +d01gaf() == + htInitPage('"D01GAF - \space{1} 1-D quadrature, integration of function defined by data values, Gill-Miller method", nil) + htMakePage '( + (domainConditions + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXd01gaf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d01gaf| '|NagIntegrationPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "Evaluates the integral ") + (text . "\inputbitmap{\htbmdir{}/d01gaf1.bitmap} y(x)dx ") + (text . "where the numerical value of the function {\em y} is ") + (text . "specified at the n distinct points \vspace{-26} ") + (text . "\inputbitmap{\htbmdir{}/d01gaf2.bitmap} ") + (text . "\blankline ") + (text . "Enter the number of points:") + (text . "\newline\tab{2} ") + (bcStrings (5 21 n PI)) + (text . "\blankline ") + (text . "\newline Ifail value:") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'd01gafSolve) + htShowPage() + +d01gafSolve htPage == + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + n = '21 => d01gafDefaultSolve(htPage,ifail) + labelList := + "append"/[f(i) for i in 1..n] where f(i) == + prefix := ('"\newline \tab{2} ") + post := ('"\tab{40} ") + xnam := INTERN STRCONC ('"x",STRINGIMAGE i) + ynam := INTERN STRCONC ('"y",STRINGIMAGE i) + [['text,:prefix],['bcStrings,[10, 0.0, xnam, 'F]], + ['text,:post],['bcStrings,[10, 0.0, ynam, 'F]]] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :labelList] + page := htInitPage("D01GAF - 1-D quadrature, integration of function defined by data values", htpPropertyList htPage) + htSay '"\menuitemstyle{}\tab{2} Enter values for {\em x}: \tab{38} " + htSay '"\menuitemstyle{}\tab{40} Enter values for {\em y}: " + htMakePage equationPart + htSay '"\blankline " + htSay '"Note:\space{1}{\em x} values in ascending or descending order only " + htMakeDoneButton('"Continue",'d01gafGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +d01gafDefaultSolve (htPage, ifail) == + n := '21 + page := htInitPage('"D01GAF - 1-D quadrature, integration of function defined by data values",htpPropertyList htPage) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Enter values for {\em x}: \tab{38} ") + (text . "\menuitemstyle{}\tab{40} Enter values for {\em y}: ") + (text . "\newline \tab{2}") + (bcStrings (10 "0.00" x1 F)) + (text . "\tab{40} ") + (bcStrings (10 "4.0000" y1 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.04" x2 F)) + (text . "\tab{40} ") + (bcStrings (10 "3.9936" y2 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.08" x3 F)) + (text . "\tab{40} ") + (bcStrings (10 "3.9746" y3 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.12" x4 F)) + (text . "\tab{40} ") + (bcStrings (10 "3.9432" y4 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.22" x5 F)) + (text . "\tab{40} ") + (bcStrings (10 "3.8153" y5 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.26" x6 F)) + (text . "\tab{40} ") + (bcStrings (10 "3.7467" y6 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.30" x7 F)) + (text . "\tab{40} ") + (bcStrings (10 "3.6697" y7 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.38" x8 F)) + (text . "\tab{40} ") + (bcStrings (10 "3.4943" y8 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.39" x9 F)) + (text . "\tab{40} ") + (bcStrings (10 "3.4719" y9 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.42" x10 F)) + (text . "\tab{40} ") + (bcStrings (10 "3.4002" y10 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.45" x11 F)) + (text . "\tab{40} ") + (bcStrings (10 "3.3264" y11 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.46" x12 F)) + (text . "\tab{40} ") + (bcStrings (10 "3.3014" y12 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.60" x13 F)) + (text . "\tab{40} ") + (bcStrings (10 "2.9412" y13 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.68" x14 F)) + (text . "\tab{40} ") + (bcStrings (10 "2.7352" y14 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.72" x15 F)) + (text . "\tab{40} ") + (bcStrings (10 "2.6344" y15 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.73" x16 F)) + (text . "\tab{40} ") + (bcStrings (10 "2.6094" y16 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.83" x17 F)) + (text . "\tab{40} ") + (bcStrings (10 "2.3684" y17 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.85" x18 F)) + (text . "\tab{40} ") + (bcStrings (10 "2.3222" y18 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.88" x19 F)) + (text . "\tab{40} ") + (bcStrings (10 "2.2543" y19 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.90" x20 F)) + (text . "\tab{40} ") + (bcStrings (10 "2.2099" y20 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "1.00" x21 F)) + (text . "\tab{40} ") + (bcStrings (10 "2.0000" y21 F)) + (text . "\newline \tab{2} ") + (text . "\blankline ") + (text . "Note:\space{1}{\em x} values in ascending or descending order only ") + (text . "\blankline")) + htMakeDoneButton('"Continue",'d01gafGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +d01gafGen htPage == + n := htpProperty(htPage,'n) + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + while y repeat + right := STRCONC ((first y).1," ") + y := rest y + left := STRCONC ((first y).1," ") + y := rest y + reallist := [left,:reallist] + imaglist := [right,:imaglist] + realstring := bcwords2liststring reallist + imagstring := bcwords2liststring imaglist + linkGen STRCONC ('"d01gaf([",realstring,"],[",imagstring,"],",STRINGIMAGE n,",", STRINGIMAGE ifail,")") + +d01fcf() == + htInitPage('"D01FCF - Multi-dimensional adaptive quadrature over hyper-rectangle",nil) + htMakePage '( + (domainConditions + (isDomain EM $EmptyMode) + (isDomain PI (PositiveInteger)) + (isDomain F (Float))) + (text . "\windowlink{Manual Page}{manpageXXd01fcf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d01fcf| '|NagIntegrationPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "Evaluates the multi-dimensional integral ") + (text . "\center{\htbitmap{d01fcf}}") + (text . "with constant finite limits, using an adaptive subdivision ") + (text . "strategy.") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Number of dimensions n in the integral, 2 \htbitmap{less=} ") + (text . "{\it NDIM} \htbitmap{less=} 15: ") + (text . "\newline\tab{2} ") + (bcStrings (6 4 ndim F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Enter the integrand {\it f} in terms of X[1]...X[n]: ") + (text . "\newline ") + (bcStrings (58 "4.0*X[1]*X[3]*X[3]*exp(2.0*X[1]*X[3])/((1.0+X[2]+X[4])**2)" expression EM)) + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} ") + (text . "\newline Minimum number of evaluations: ") + (text . "\tab{32} \menuitemstyle{}\tab{34} ") + (text . "Maximum number of evaluations: ") + (text . "\newline\tab{2} ") + (bcStrings (10 1000 minpts PI)) + (text . "\tab{34} ") + (bcStrings (10 5700 maxpts PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Relative accuracy required:") + (text . "\newline\tab{2} ") + (bcStrings (10 "0.0001" eps F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Dimension of workspace array: ") + (text . "\newline\tab{2} ") + (bcStrings (10 606 lenwrk 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", 'd01fcfSolve) + htShowPage() + + +d01fcfSolve htPage == + ndim := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ndim) + objValUnwrap htpLabelSpadValue(htPage, 'ndim) + expression := htpLabelInputString(htPage,'expression) + minpts := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'minpts) + objValUnwrap htpLabelSpadValue(htPage, 'minpts) + maxpts := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'maxpts) + objValUnwrap htpLabelSpadValue(htPage, 'maxpts) + eps := htpLabelInputString(htPage,'eps) + lenwrk := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lenwrk) + objValUnwrap htpLabelSpadValue(htPage, 'lenwrk) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + ndim = '4 => d01fcfDefaultSolve(htPage,minpts,maxpts,eps,lenwrk,expression,ifail) + labelList := + "append"/[f(i) for i in 1..ndim] where f(i) == + prefix := ('"\newline \tab{2} ") + post := ('"\tab{32} ") + rnam := INTERN STRCONC ('"a",STRINGIMAGE i) + inam := INTERN STRCONC ('"b",STRINGIMAGE i) + [['text,:prefix],['bcStrings,[10, 0.0, rnam, 'P]], + ['text,:post],['bcStrings,[10, 1.0, inam, 'P]]] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain PI (PositiveInteger))), + :labelList] + page := htInitPage('"D01FCF - Multi-dimensional adaptive quadrature over hyper-rectangle",nil) + htSay '"Please enter the limits of integration:- " + htSay '"\blankline " + htSay '"\menuitemstyle{}\tab{2} Lower limits: \tab{30} " + htSay '"\menuitemstyle{}\tab{32} Upper limits: " + htMakePage equationPart + htMakeDoneButton('"Continue",'d01fcfGen) + htpSetProperty(page,'ndim,ndim) + htpSetProperty(page,'expression,expression) + htpSetProperty(page,'minpts,minpts) + htpSetProperty(page,'maxpts,maxpts) + htpSetProperty(page,'eps,eps) + htpSetProperty(page,'lenwrk,lenwrk) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +d01fcfDefaultSolve(htPage,minpts,maxpts,eps,lenwrk,expression,ifail) == + ndim := '4 + page := htInitPage('"D01FCF - Multi-dimensional adaptive quadrature over hyper-rectangle",nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\newline ") + (text . "Please enter the limits of integration:- ") + (text . "\blankline ") + (text . "\newline \menuitemstyle{} \tab{2} ") + (text . "Lower limits: \tab{30} ") + (text . "\menuitemstyle{} \tab{32} Upper limits: ") + (text . "\newline \tab{2} ") + (bcStrings (10 "0.0" a1 F)) + (text . "\tab{32} ") + (bcStrings (10 "1.0" b1 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.0" a2 F)) + (text . "\tab{32} ") + (bcStrings (10 "1.0" b2 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.0" a3 F)) + (text . "\tab{32} ") + (bcStrings (10 "1.0" b3 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.0" a4 F)) + (text . "\tab{32} ") + (bcStrings (10 "1.0" b4 F)) + (text . "\newline ") + (text . "\blankline")) + htMakeDoneButton('"Continue",'d01fcfGen) + htpSetProperty(page,'ndim,ndim) + htpSetProperty(page,'expression,expression) + htpSetProperty(page,'minpts,minpts) + htpSetProperty(page,'maxpts,maxpts) + htpSetProperty(page,'eps,eps) + htpSetProperty(page,'lenwrk,lenwrk) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +d01fcfGen htPage == + ndim := htpProperty(htPage,'ndim) + minpts := htpProperty(htPage,'minpts) + maxpts := htpProperty(htPage,'maxpts) + eps := htpProperty(htPage,'eps) + lenwrk := htpProperty(htPage,'lenwrk) + expression := htpProperty(htPage,'expression) + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + while y repeat + right := (first y).1 + y := rest y + left := (first y).1 + y := rest y + reallist := [left,:reallist] + imaglist := [right,:imaglist] + astring := bcwords2liststring reallist + bstring := bcwords2liststring imaglist + prefix := STRCONC("d01fcf(",STRINGIMAGE ndim,", [",astring,"],[",bstring,"], ") + middle := STRCONC(STRINGIMAGE maxpts,", ",eps," ,",STRINGIMAGE lenwrk," ,") + middle := STRCONC(middle,STRINGIMAGE minpts," ,",STRINGIMAGE ifail," ,") + end := STRCONC("(",expression,"::Expression Float) :: ASP4(FUNCTN))") + linkGen STRCONC(prefix,middle,end) + + +d01gbf() == + htInitPage('"D01GBF - Multi-dimensional quadrature over hyper-rectangle, Monte Carlo method",nil) + htMakePage '( + (domainConditions + (isDomain EM $EmptyMode) + (isDomain PI (PositiveInteger)) + (isDomain F (Float))) + (text . "\windowlink{Manual Page}{manpageXXd01gbf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d01gbf| '|NagIntegrationPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "Evaluates the multidimensional integral ") + (text . "\center{\htbitmap{d01fcf}} with constant finite limits, ") + (text . "using an adaptive Monte-Carlo method;") + (text . " the routine is suitable for low accuracy work. ") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Number of dimensions n in the integral, {\it NDIM}:") + (text . "\newline\tab{2} ") + (bcStrings (6 4 ndim F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Enter the integrand {\it f} in terms of X[1]...X[n]: ") + (text . "\newline ") + (bcStrings (60 "4.0*X[1]*X[3]*X[3]*exp(2.0*X[1]*X[3])/((1.0+X[2]+X[4])**2)" expression EM)) + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} ") + (text . "\newline Minimum number of FUNCTN calls: ") + (text . "\tab{32} \menuitemstyle{}\tab{34} ") + (text . "Maximum number of FUNCTN calls: ") + (text . "\newline\tab{2} ") + (bcStrings (10 1000 mincls PI)) + (text . "\tab{34} ") + (bcStrings (10 20000 maxcls PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Relative accuracy required:") + (text . "\newline\tab{2} ") + (bcStrings (10 "0.01" eps F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Dimension of workspace array: ") + (text . "\newline\tab{2} ") + (bcStrings (10 500 lenwrk 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", 'd01gbfSolve) + htShowPage() + + +d01gbfSolve htPage == + ndim := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ndim) + objValUnwrap htpLabelSpadValue(htPage, 'ndim) + expression := htpLabelInputString(htPage,'expression) + mincls := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'mincls) + objValUnwrap htpLabelSpadValue(htPage, 'mincls) + maxcls := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'maxcls) + objValUnwrap htpLabelSpadValue(htPage, 'maxcls) + eps := htpLabelInputString(htPage,'eps) + lenwrk := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lenwrk) + objValUnwrap htpLabelSpadValue(htPage, 'lenwrk) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + ndim = '4 => d01gbfDefaultSolve(htPage,mincls,maxcls,eps,lenwrk,expression,ifail) + labelList := + "append"/[f(i) for i in 1..ndim] where f(i) == + prefix := ('"\newline \tab{2} ") + post := ('"\tab{32} ") + rnam := INTERN STRCONC ('"a",STRINGIMAGE i) + inam := INTERN STRCONC ('"b",STRINGIMAGE i) + [['text,:prefix],['bcStrings,[10, 0.0, rnam, 'P]], + ['text,:post],['bcStrings,[10, 1.0, inam, 'P]]] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain PI (PositiveInteger))), + :labelList] + page := htInitPage('"D01GBF - Multi-dimensional quadrature over hyper-rectangle, Monte Carlo method",nil) + htSay '"Please enter the limits of integration:- " + htSay '"\blankline " + htSay '"\menuitemstyle{}\tab{2} Lower limits: \tab{30} " + htSay '"\menuitemstyle{}\tab{32} Upper limits: " + htMakePage equationPart + htMakeDoneButton('"Continue",'d01gbfGen) + htpSetProperty(page,'ndim,ndim) + htpSetProperty(page,'expression,expression) + htpSetProperty(page,'mincls,mincls) + htpSetProperty(page,'maxcls,maxcls) + htpSetProperty(page,'eps,eps) + htpSetProperty(page,'lenwrk,lenwrk) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +d01gbfDefaultSolve(htPage,mincls,maxcls,eps,lenwrk,expression,ifail) == + ndim := '4 + page := htInitPage('"D01GBF - Multi-dimensional quadrature over hyper-rectangle, Monte Carlo method",nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\newline ") + (text . "Please enter the limits of integration:- ") + (text . "\blankline ") + (text . "\newline \menuitemstyle{} \tab{2} ") + (text . "Lower limits: \tab{30} ") + (text . "\menuitemstyle{} \tab{32} Upper limits: ") + (text . "\newline \tab{2} ") + (bcStrings (10 "0.0" a1 F)) + (text . "\tab{32} ") + (bcStrings (10 "1.0" b1 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.0" a2 F)) + (text . "\tab{32} ") + (bcStrings (10 "1.0" b2 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.0" a3 F)) + (text . "\tab{32} ") + (bcStrings (10 "1.0" b3 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.0" a4 F)) + (text . "\tab{32} ") + (bcStrings (10 "1.0" b4 F)) + (text . "\newline ") + (text . "\blankline")) + htMakeDoneButton('"Continue",'d01gbfGen) + htpSetProperty(page,'ndim,ndim) + htpSetProperty(page,'expression,expression) + htpSetProperty(page,'mincls,mincls) + htpSetProperty(page,'maxcls,maxcls) + htpSetProperty(page,'eps,eps) + htpSetProperty(page,'lenwrk,lenwrk) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + + + +d01gbfGen htPage == + ndim := htpProperty(htPage,'ndim) + mincls := htpProperty(htPage,'mincls) + maxcls := htpProperty(htPage,'maxcls) + eps := htpProperty(htPage,'eps) + lenwrk := htpProperty(htPage,'lenwrk) + expression := htpProperty(htPage,'expression) + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + while y repeat + right := (first y).1 + y := rest y + left := (first y).1 + y := rest y + reallist := [left,:reallist] + imaglist := [right,:imaglist] + astring := bcwords2liststring reallist + bstring := bcwords2liststring imaglist + prefix := STRCONC("d01gbf(",STRINGIMAGE ndim,", [",astring,"],[",bstring,"], ") + middle := STRCONC(STRINGIMAGE maxcls,", ",eps," ,",STRINGIMAGE lenwrk," ,") + middle := STRCONC(middle,STRINGIMAGE mincls," ,[[0.0 for i in 1..") + middle := STRCONC(middle,STRINGIMAGE lenwrk,"]],",STRINGIMAGE ifail," ,") + end := STRCONC("(",expression,"::Expression Float) :: ASP4(FUNCTN))") + linkGen STRCONC(prefix,middle,end) + +d01bbf() == + htInitPage('"D01BBF - Weights and abscissae for Gaussian quadrature rules",nil) + htMakePage '( + (domainConditions + (isDomain EM $EmptyMode) + (isDomain PI (PositiveInteger)) + (isDomain F (Float))) + (text . "\windowlink{Manual Page}{manpageXXd01bbf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d01bbf| '|NagIntegrationPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "Returns the weights and abscissae appropriate to a Gaussian ") + (text . "quadrature formula with a specified number of abscissae. ") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Enter the D01XXX subroutine: ") + (radioButtons gtype + ("" " D01BAZ" gZero) + ("" " D01BAY" gOne) + ("" " D01BAX" gTwo) + ("" " D01BAW" gThree)) + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} ") + (text . "\newline {\em Lower} bound of the interval: ") + (text . "\tab{32} \menuitemstyle{}\tab{34} ") + (text . "{\em Upper} bound:") + (text . "\newline\tab{2} ") + (bcStrings (20 "0.0" a F)) + (text . "\tab{34} ") + (bcStrings (20 "1.0" b EM)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Type of weights for Gauss-Laguerre or Gauss-Hermite quadrature:") + (radioButtons itype + ("" " adjusted weights" iOne) + ("" " normal weights" iZero)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "\newline Number of weights & abscissae to be used {\em n}:") + (text . "\newline\tab{2} ") + (bcStrings (10 "6" n 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", 'd01bbfGen) + htShowPage() + +d01bbfGen htPage == + sub := htpButtonValue(htPage,'gtype) + gtype := + sub = 'gZero => 0 + sub = 'gOne => 1 + sub = 'gTwo => 2 + 3 + a := htpLabelInputString(htPage,'a) + b := htpLabelInputString(htPage,'b) + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + wgts := htpButtonValue(htPage,'itype) + itype := + wgts = 'iOne => 1 + 0 + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => 1 + -1 + prefix := STRCONC("d01bbf(",a," ,",b," ,",STRINGIMAGE itype," ,") + end := STRCONC(STRINGIMAGE n," ,",STRINGIMAGE gtype," ,",STRINGIMAGE ifail,")") + linkGen STRCONC(prefix,end) diff --git a/src/interp/nag-d01.boot.pamphlet b/src/interp/nag-d01.boot.pamphlet deleted file mode 100644 index 5d2afbe2..00000000 --- a/src/interp/nag-d01.boot.pamphlet +++ /dev/null @@ -1,1361 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp nag-d01.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. - -@ -<<*>>= -<> - -)package "BOOT" - -d01ajf() == - htInitPage('"D01AJF - 1-D quadrature, adaptive, finite interval, allowing for badly-behaved integrands", nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain PI (PositiveInteger)) - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXd01ajf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d01ajf| '|NagIntegrationPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "Evaluates the integral ") - (text . "\inputbitmap{\htbmdir{}/integral.bitmap} f(x) dx ") - (text . "using an adaptive method. ") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Enter the {\em function} f to be integrated in terms of X: ") - (text . "\newline \tab{2} ") - (bcStrings (55 "X*sin(30*X)/(sqrt(1-(X/(2*\%pi))**2))" expression EM)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") - (text . "\newline {\em Lower} bound of the interval: ") - (text . "\tab{32} \menuitemstyle{}\tab{34} ") - (text . "{\em Upper} bound:") - (text . "\newline\tab{2} ") - (bcStrings (20 "0.0" a F)) - (text . "\tab{34} ") - (bcStrings (20 "\%pi*2" b EM)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "\newline Absolute accuracy required:") - (text . "\tab{32} \menuitemstyle{}\tab{34}") - (text . "Relative accuracy:") - (text . "\newline\tab{2} ") - (bcStrings (10 "0.0" epsabs F)) - (text . "\tab{34} ") - (bcStrings (10 "1.0e-4" epsrel F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Dimension of workspace array: ") - (text . "\newline\tab{2} ") - (bcStrings (10 800 lw 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", 'd01ajfGen) - htShowPage() - -d01ajfGen htPage == - lw := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lw) - objValUnwrap htpLabelSpadValue(htPage, 'lw) - a := htpLabelInputString(htPage,'a) - b := htpLabelInputString(htPage,'b) - epsabs := htpLabelInputString(htPage,'epsabs) - epsrel := htpLabelInputString(htPage,'epsrel) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => 1 - -1 - express := htpLabelInputString(htPage,'expression) - liw := lw/4 - prefix := STRCONC("d01ajf(",a," ,",b," ,",epsabs," ,",epsrel," ,",STRINGIMAGE lw) - middle := STRCONC(" ,",STRINGIMAGE liw," ,",STRINGIMAGE ifail," ,") - end := STRCONC("(",express,"::Expression Float) :: ASP1(F))") - linkGen STRCONC(prefix,middle,end) - -d01akf() == - htInitPage('"D01AKF - 1-D quadrature, adaptive, finite interval, method suitable for oscillating functions", nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain PI (PositiveInteger)) - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXd01akf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d01akf| '|NagIntegrationPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "Computes \space{1} \inputbitmap{\htbmdir{}/integral.bitmap} ") - (text . "f(x) dx using an adaptive method, ") - (text . "especially suited to oscillating, non-singular integrands. ") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Enter the {\em function} f to be integrated in terms of X: ") - (text . "\newline \tab{2} ") - (bcStrings (55 "X*sin(30*X)*cos(X)" expression EM)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") - (text . "\newline {\em Lower} bound of the interval: ") - (text . "\tab{32} \menuitemstyle{}\tab{34} ") - (text . "{\em Upper} bound:") - (text . "\newline\tab{2} ") - (bcStrings (20 "0.0" a F)) - (text . "\tab{34} ") - (bcStrings (20 "\%pi*2" b EM)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "\newline Absolute accuracy required:") - (text . "\tab{32} \menuitemstyle{}\tab{34}") - (text . "Relative accuracy:") - (text . "\newline\tab{2} ") - (bcStrings (10 "0.0" epsabs F)) - (text . "\tab{34} ") - (bcStrings (10 "1.0e-4" epsrel F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Dimension of workspace array: ") - (text . "\newline\tab{2} ") - (bcStrings (10 800 lw 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", 'd01akfGen) - htShowPage() - -d01akfGen htPage == - lw := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lw) - objValUnwrap htpLabelSpadValue(htPage, 'lw) - a := htpLabelInputString(htPage,'a) - b := htpLabelInputString(htPage,'b) - epsabs := htpLabelInputString(htPage,'epsabs) - epsrel := htpLabelInputString(htPage,'epsrel) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => 1 - -1 - express := htpLabelInputString(htPage,'expression) - liw := lw/4 - prefix := STRCONC("d01akf(",a," ,",b," ,",epsabs," ,",epsrel," ,",STRINGIMAGE lw) - middle := STRCONC(" ,",STRINGIMAGE liw," ,",STRINGIMAGE ifail," ,") - end := STRCONC("(",express,"::Expression Float) :: ASP1(F))") - linkGen STRCONC(prefix,middle,end) - -d01alf() == - htInitPage('"D01ALF - 1-D quadrature, adaptive, finite interval, allowing for singularities at user-specified break-points ", nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain PI (PositiveInteger)) - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXd01alf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d01alf| '|NagIntegrationPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "Evaluates the integral \space{1} ") - (text . "\inputbitmap{\htbmdir{}/integral.bitmap} f(x) dx; ") - (text . "the integrand may have local singular behaviour at a ") - (text . "finite number of points within [a,b]. ") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Enter the {\em function} f to be integrated in terms of X: ") - (text . "\newline \tab{2} ") - (bcStrings (55 "1/sqrt(abs(X-1/7))" expression EM)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") - (text . "\newline {\em Lower} bound of the interval: ") - (text . "\tab{32} \menuitemstyle{}\tab{34} ") - (text . "{\em Upper} bound:") - (text . "\newline\tab{2} ") - (bcStrings (20 "0.0" a F)) - (text . "\tab{34} ") - (bcStrings (20 "1.0" b EM)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "\newline Number of user supplied break-points: \tab{38}") - (bcStrings (10 "1" npts PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "\newline User supplied break-points (separated by commas): ") - (text . "\newline \tab{2} ") - (bcStrings (40 "1/7" points EM)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "\newline Absolute accuracy required:") - (text . "\tab{32} \menuitemstyle{}\tab{34}") - (text . "Relative accuracy:") - (text . "\newline\tab{2} ") - (bcStrings (10 "0.0" epsabs F)) - (text . "\tab{34} ") - (bcStrings (10 "1.0e-4" epsrel F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Dimension of workspace array: ") - (text . "\newline\tab{2} ") - (bcStrings (10 800 lw 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", 'd01alfGen) - htShowPage() - -d01alfGen htPage == - lw := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lw) - objValUnwrap htpLabelSpadValue(htPage, 'lw) - a := htpLabelInputString(htPage,'a) - b := htpLabelInputString(htPage,'b) - npts := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'npts) - objValUnwrap htpLabelSpadValue(htPage, 'npts) - points := htpLabelInputString(htPage, 'points) - points := STRCONC ('"[[",points,"]]") - epsabs := htpLabelInputString(htPage,'epsabs) - epsrel := htpLabelInputString(htPage,'epsrel) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => 1 - -1 - express := htpLabelInputString(htPage,'expression) - liw := lw/2 - prefix := STRCONC('"d01alf(",a," ,",b," ,",STRINGIMAGE npts,",",points,",") - prefix := STRCONC(prefix,epsabs," ,",epsrel," ,",STRINGIMAGE lw) - middle := STRCONC('" ,",STRINGIMAGE liw," ,",STRINGIMAGE ifail," ,") - end := STRCONC('"(",express,"::Expression Float) :: ASP1(F))") - linkGen STRCONC(prefix,middle,end) - -d01amf() == - htInitPage('"D01AMF 1-D quadrature, adaptive, infinite or semi-infinite interval",nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain PI (PositiveInteger)) - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXd01amf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d01amf| '|NagIntegrationPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "Evaluates the integral \space{1} ") - (text . "\inputbitmap{\htbmdir{}/integral.bitmap} f(x) dx, ") - (text . "where (a,b) can be an infinite or semi-infinite interval.") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Enter the {\em function} f to be integrated in terms of X: ") - (text . "\newline \tab{2} ") - (bcStrings (55 "1/((X+1)*sqrt(X))" expression EM)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") - (text . "\newline {\em Bound} the finite limit of the integration range: ") - (text . "\newline\tab{2} ") - (bcStrings (10 "0.0" a F)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") - (text . "\newline Choose the kind of integration range: ") - (radioButtons inf - (" 1" "\tab{2} Range is [Bound, +infinity] " plus) - ("-1" "\tab{2} Range is [-infinity, Bound] " minus) - ("2" "\tab{2} Range is [-infinity, +infinity] (Bound is not used) " minusPlus)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "\newline Absolute accuracy required:") - (text . "\tab{32} \menuitemstyle{}\tab{34}") - (text . "Relative accuracy:") - (text . "\newline\tab{2} ") - (bcStrings (10 "0.0" epsabs F)) - (text . "\tab{34} ") - (bcStrings (10 "1.0e-4" epsrel F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Dimension of workspace array: ") - (text . "\newline\tab{2} ") - (bcStrings (10 800 lw 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", 'd01amfGen) - htShowPage() - -d01amfGen htPage == - lw := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lw) - objValUnwrap htpLabelSpadValue(htPage, 'lw) - a := htpLabelInputString(htPage,'a) - b := htpLabelInputString(htPage,'b) - infinity := htpButtonValue(htPage,'inf) - inf := - infinity = 'plus => 1 - infinity = 'minus => -1 - 2 - epsabs := htpLabelInputString(htPage,'epsabs) - epsrel := htpLabelInputString(htPage,'epsrel) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => 1 - -1 - express := htpLabelInputString(htPage,'expression) - liw := lw/4 - prefix := STRCONC('"d01amf(",a," ,",STRINGIMAGE inf," ,") - prefix := STRCONC(prefix,epsabs," ,",epsrel," ,",STRINGIMAGE lw) - middle := STRCONC('" ,",STRINGIMAGE liw," ,",STRINGIMAGE ifail," ,") - end := STRCONC('"(",express,"::Expression Float) :: ASP1(F))") - linkGen STRCONC(prefix,middle,end) - -d01anf() == - htInitPage('"D01ANF - 1-D quadrature, adaptive, finite interval, weight function cos(\omega x) or sin(\omega x)", nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain PI (PositiveInteger)) - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXd01anf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d01anf| '|NagIntegrationPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "Evaluates \inputbitmap{\htbmdir{}/integral.bitmap} g(x)sin(\omega x) dx ") - (text . "or \inputbitmap{\htbmdir{}/integral.bitmap} g(x)cos(\omega x) dx, ") - (text . "the sine and cosine transform respectively. ") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Enter the {\em function} f to be integrated in terms of X: ") - (text . "\newline \tab{2} ") - (bcStrings (55 "log(X)" expression EM)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") - (text . "\newline {\em Lower} bound of the interval: ") - (text . "\tab{32} \menuitemstyle{}\tab{34} ") - (text . "{\em Upper} bound:") - (text . "\newline\tab{2} ") - (bcStrings (20 "1.0e-6" a F)) - (text . "\tab{34} ") - (bcStrings (20 "1.0" b EM)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "\newline Absolute accuracy required:") - (text . "\tab{32} \menuitemstyle{}\tab{34}") - (text . "Relative accuracy:") - (text . "\newline\tab{2} ") - (bcStrings (10 "0.0" epsabs F)) - (text . "\tab{34} ") - (bcStrings (10 "1.0e-4" epsrel F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Dimension of workspace: ") - (text . "\tab{32} \menuitemstyle{}\tab{34}") - (text . "\omega the weight function:") - (text . "\newline\tab{2} ") - (bcStrings (10 800 lw PI)) - (text . "\tab{34} ") - (bcStrings (20 "10*\%pi" omega F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Key value, indicates which integral is to be computed:") - (radioButtons key - ("" " sin" sin) - ("" " cos" cos)) - (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", 'd01anfGen) - htShowPage() - -d01anfGen htPage == - lw := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lw) - objValUnwrap htpLabelSpadValue(htPage, 'lw) - a := htpLabelInputString(htPage,'a) - b := htpLabelInputString(htPage,'b) - epsabs := htpLabelInputString(htPage,'epsabs) - epsrel := htpLabelInputString(htPage,'epsrel) - omega := htpLabelInputString(htPage,'omega) - type := htpButtonValue(htPage,'key) - key := - type = 'cos => 1 - 2 - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => 1 - -1 - express := htpLabelInputString(htPage,'expression) - liw := lw/4 - prefix := STRCONC("d01anf(",a," ,",b," ,",omega," ,",STRINGIMAGE key," ,",epsabs," ,",epsrel," ,",STRINGIMAGE lw) - middle := STRCONC(" ,",STRINGIMAGE liw," ,",STRINGIMAGE ifail," ,") - end := STRCONC("(",express,"::Expression Float) :: ASP1(G))") - linkGen STRCONC(prefix,middle,end) - -d01apf() == - htInitPage('"D01APF - 1-D quadrature, adaptive, finite interval, weight function with end point singularities of algebraico-logarithmic type", nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain PI (PositiveInteger)) - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXd01apf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d01apf| '|NagIntegrationPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "Evaluates \inputbitmap{\htbmdir{}/integral.bitmap} g(x)w(x) dx, where w(x) ") - (text . "has end-point singularities of algebraico-logarithmic type. ") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Enter the {\em function} g(x) in terms of X: ") - (text . "\newline \tab{2} ") - (bcStrings (55 "sin(10*X)" expression EM)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") - (text . "\newline {\em Lower} bound of the interval: ") - (text . "\tab{32} \menuitemstyle{}\tab{34} ") - (text . "{\em Upper} bound:") - (text . "\newline\tab{2} ") - (bcStrings (20 "1.0e-6" a F)) - (text . "\tab{34} ") - (bcStrings (20 "1.0" b EM)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "\newline \alpha in the weight function:") - (text . "\tab{32} \menuitemstyle{}\tab{34}") - (text . "\beta in the weight function:") - (text . "\newline\tab{2} ") - (bcStrings (10 "-0.5" alpha F)) - (text . "\tab{34} ") - (bcStrings (10 "-0.5" beta F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "\newline Absolute accuracy required:") - (text . "\tab{32} \menuitemstyle{}\tab{34}") - (text . "Relative accuracy:") - (text . "\newline\tab{2} ") - (bcStrings (10 "0.0" epsabs F)) - (text . "\tab{34} ") - (bcStrings (10 "1.0e-4" epsrel F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Dimension of workspace: ") - (text . "\newline\tab{2} ") - (bcStrings (10 800 lw PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Key value, indicates which weight function is to be used: ") - (radioButtons key - ("" "\space{1}w(x) = (x-a)**\alpha\space{1}* (b-x)**\beta" kone) - ("" "\space{1}w(x) = (x-a)**\alpha\space{1}* (b-x)**\beta * ln(x-a)" ktwo) - ("" "\space{1}w(x) = (x-a)**\alpha\space{1}* (b-x)**\beta * ln(b-x)" kthree) - ("" "\space{1}w(x) = (x-a)**\alpha\space{1}* (b-x)**\beta * ln(x-a) * ln(b-x) " kfour)) - (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", 'd01apfGen) - htShowPage() - -d01apfGen htPage == - express := htpLabelInputString(htPage,'expression) - lw := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lw) - objValUnwrap htpLabelSpadValue(htPage, 'lw) - a := htpLabelInputString(htPage,'a) - b := htpLabelInputString(htPage,'b) - alpha := htpLabelInputString(htPage,'alpha) - beta := htpLabelInputString(htPage,'beta) - epsabs := htpLabelInputString(htPage,'epsabs) - epsrel := htpLabelInputString(htPage,'epsrel) - type := htpButtonValue(htPage,'key) - key := - type = 'kone => 1 - type = 'ktwo => 2 - type = 'kthree => 3 - 4 - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => 1 - -1 - liw := lw/4 - prefix := STRCONC("d01apf(",a," ,",b," ,",alpha," ,",beta," ,") - prefix := STRCONC(prefix,STRINGIMAGE key," ,",epsabs," ,",epsrel," ,") - prefix := STRCONC(prefix,STRINGIMAGE lw," ,",STRINGIMAGE liw," ,") - end := STRCONC("(",express,"::Expression Float) :: ASP1(G))") - linkGen STRCONC(prefix,STRINGIMAGE ifail," ,",end) - -d01aqf() == - htInitPage('"D01AQF - 1-D quadrature, adaptive, finite interval, weight function 1/(x-c), Cauchy principal value (Hilbert transform)",nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain PI (PositiveInteger)) - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXd01aqf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d01aqf| '|NagIntegrationPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "Evaluates the Hilbert transform \inputbitmap{\htbmdir{}/integral.bitmap}") - (text . "g(x)/(x-c) dx.") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Enter the function {\it g(x)} in terms of X: ") - (text . "\newline \tab{2} ") - (bcStrings (55 "(X**2+0.01**2)**-1" expression EM)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") - (text . "\newline {\em Lower} bound of the interval {\it a}: ") - (text . "\tab{32} \menuitemstyle{}\tab{34} ") - (text . "{\em Upper} bound {\it b}:") - (text . "\newline\tab{2} ") - (bcStrings (20 "-1.0" a F)) - (text . "\tab{34} ") - (bcStrings (20 "1.0" b F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} \newline ") - (text . "Parameter {\it c} \notequal {\it a} or {\it b}: ") - (text . "\newline \tab{2} ") - (bcStrings (10 "0.5" c F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "\newline Absolute accuracy required:") - (text . "\tab{32} \menuitemstyle{}\tab{34}") - (text . "Relative accuracy:") - (text . "\newline\tab{2} ") - (bcStrings (10 "0.0" epsabs F)) - (text . "\tab{34} ") - (bcStrings (10 "1.0e-4" epsrel F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Dimension of workspace: ") - (text . "\newline\tab{2} ") - (bcStrings (10 800 lw 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", 'd01aqfGen) - htShowPage() - -d01aqfGen htPage == - express := htpLabelInputString(htPage,'expression) - lw := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lw) - objValUnwrap htpLabelSpadValue(htPage, 'lw) - a := htpLabelInputString(htPage,'a) - b := htpLabelInputString(htPage,'b) - c := htpLabelInputString(htPage,'c) - epsabs := htpLabelInputString(htPage,'epsabs) - epsrel := htpLabelInputString(htPage,'epsrel) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => 1 - -1 - liw := lw/4 - prefix := STRCONC("d01aqf(",a," ,",b," ,",c," ,",epsabs," ,",epsrel," ,") - prefix := STRCONC(prefix,STRINGIMAGE lw," ,",STRINGIMAGE liw," ,") - end := STRCONC("((",express,")::Expression Float) :: ASP1(G))") - linkGen STRCONC(prefix,STRINGIMAGE ifail," ,",end) - -d01asf() == - htInitPage('"D01ASF - 1-D quadrature, adaptive, semi-infinite interval, weight function cos(\omega x) or sin(\omega x)", nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain PI (PositiveInteger)) - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXd01asf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d01asf| '|NagIntegrationPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "Evaluates \inputbitmap{\htbmdir{}/si-integral.bitmap} ") - (text . "g(x)sin(\omega x) dx ") - (text . "or \inputbitmap{\htbmdir{}/si-integral.bitmap} ") - (text . "g(x)cos(\omega x) dx, ") - (text . "the sine and cosine transform respectively. ") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Enter the function {\it g(x)} in terms of X: ") - (text . "\newline \tab{2} ") - (bcStrings (45 "1/sqrt(X)" expression EM)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") - (text . "\newline {\em Lower} bound of the interval: ") - (text . "\newline \tab{2} ") - (bcStrings (10 "1.0e-12" a F)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") - (text . "Parameter \omega in the weight function of the transform: ") - (text . "\newline \tab{2} ") - (bcStrings (10 "\%pi/2" omega F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "\newline Absolute accuracy required:") - (text . "\newline\tab{2} ") - (bcStrings (10 "1.0e-3" epsabs F)) - (text . "\newline \menuitemstyle{}\tab{2}") - (text . "Dimension of workspace array: ") - (text . "\newline\tab{2} ") - (bcStrings (10 800 lw PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "{\it LIMLST} upper bound on number of intervals:") - (text . "\newline\tab{2} ") - (bcStrings (10 50 limlst PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Key value, indicates which integral is to be computed:") - (radioButtons key - ("" " cos(\omega x)" cos) - ("" " sin(\omega x)" sin)) - (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", 'd01asfGen) - htShowPage() - -d01asfGen htPage == - lw := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lw) - objValUnwrap htpLabelSpadValue(htPage, 'lw) - limlst := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'limlst) - objValUnwrap htpLabelSpadValue(htPage, 'limlst) - a := htpLabelInputString(htPage,'a) - epsabs := htpLabelInputString(htPage,'epsabs) - omega := htpLabelInputString(htPage,'omega) - type := htpButtonValue(htPage,'key) - key := - type = 'cos => 1 - 2 - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => 1 - -1 - express := htpLabelInputString(htPage,'expression) - liw := lw/2 - prefix := STRCONC("d01asf(",a," ,",omega," ,",STRINGIMAGE key," ,",epsabs) - prefix := STRCONC(prefix," ,",STRINGIMAGE limlst," ,",STRINGIMAGE lw) - middle := STRCONC(" ,",STRINGIMAGE liw," ,",STRINGIMAGE ifail," ,") - end := STRCONC("(",express,"::Expression Float) :: ASP1(G))") - linkGen STRCONC(prefix,middle,end) - - - -d01gaf() == - htInitPage('"D01GAF - \space{1} 1-D quadrature, integration of function defined by data values, Gill-Miller method", nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXd01gaf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d01gaf| '|NagIntegrationPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "Evaluates the integral ") - (text . "\inputbitmap{\htbmdir{}/d01gaf1.bitmap} y(x)dx ") - (text . "where the numerical value of the function {\em y} is ") - (text . "specified at the n distinct points \vspace{-26} ") - (text . "\inputbitmap{\htbmdir{}/d01gaf2.bitmap} ") - (text . "\blankline ") - (text . "Enter the number of points:") - (text . "\newline\tab{2} ") - (bcStrings (5 21 n PI)) - (text . "\blankline ") - (text . "\newline Ifail value:") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'd01gafSolve) - htShowPage() - -d01gafSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - n = '21 => d01gafDefaultSolve(htPage,ifail) - labelList := - "append"/[f(i) for i in 1..n] where f(i) == - prefix := ('"\newline \tab{2} ") - post := ('"\tab{40} ") - xnam := INTERN STRCONC ('"x",STRINGIMAGE i) - ynam := INTERN STRCONC ('"y",STRINGIMAGE i) - [['text,:prefix],['bcStrings,[10, 0.0, xnam, 'F]], - ['text,:post],['bcStrings,[10, 0.0, ynam, 'F]]] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :labelList] - page := htInitPage("D01GAF - 1-D quadrature, integration of function defined by data values", htpPropertyList htPage) - htSay '"\menuitemstyle{}\tab{2} Enter values for {\em x}: \tab{38} " - htSay '"\menuitemstyle{}\tab{40} Enter values for {\em y}: " - htMakePage equationPart - htSay '"\blankline " - htSay '"Note:\space{1}{\em x} values in ascending or descending order only " - htMakeDoneButton('"Continue",'d01gafGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -d01gafDefaultSolve (htPage, ifail) == - n := '21 - page := htInitPage('"D01GAF - 1-D quadrature, integration of function defined by data values",htpPropertyList htPage) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter values for {\em x}: \tab{38} ") - (text . "\menuitemstyle{}\tab{40} Enter values for {\em y}: ") - (text . "\newline \tab{2}") - (bcStrings (10 "0.00" x1 F)) - (text . "\tab{40} ") - (bcStrings (10 "4.0000" y1 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.04" x2 F)) - (text . "\tab{40} ") - (bcStrings (10 "3.9936" y2 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.08" x3 F)) - (text . "\tab{40} ") - (bcStrings (10 "3.9746" y3 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.12" x4 F)) - (text . "\tab{40} ") - (bcStrings (10 "3.9432" y4 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.22" x5 F)) - (text . "\tab{40} ") - (bcStrings (10 "3.8153" y5 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.26" x6 F)) - (text . "\tab{40} ") - (bcStrings (10 "3.7467" y6 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.30" x7 F)) - (text . "\tab{40} ") - (bcStrings (10 "3.6697" y7 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.38" x8 F)) - (text . "\tab{40} ") - (bcStrings (10 "3.4943" y8 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.39" x9 F)) - (text . "\tab{40} ") - (bcStrings (10 "3.4719" y9 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.42" x10 F)) - (text . "\tab{40} ") - (bcStrings (10 "3.4002" y10 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.45" x11 F)) - (text . "\tab{40} ") - (bcStrings (10 "3.3264" y11 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.46" x12 F)) - (text . "\tab{40} ") - (bcStrings (10 "3.3014" y12 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.60" x13 F)) - (text . "\tab{40} ") - (bcStrings (10 "2.9412" y13 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.68" x14 F)) - (text . "\tab{40} ") - (bcStrings (10 "2.7352" y14 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.72" x15 F)) - (text . "\tab{40} ") - (bcStrings (10 "2.6344" y15 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.73" x16 F)) - (text . "\tab{40} ") - (bcStrings (10 "2.6094" y16 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.83" x17 F)) - (text . "\tab{40} ") - (bcStrings (10 "2.3684" y17 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.85" x18 F)) - (text . "\tab{40} ") - (bcStrings (10 "2.3222" y18 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.88" x19 F)) - (text . "\tab{40} ") - (bcStrings (10 "2.2543" y19 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.90" x20 F)) - (text . "\tab{40} ") - (bcStrings (10 "2.2099" y20 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "1.00" x21 F)) - (text . "\tab{40} ") - (bcStrings (10 "2.0000" y21 F)) - (text . "\newline \tab{2} ") - (text . "\blankline ") - (text . "Note:\space{1}{\em x} values in ascending or descending order only ") - (text . "\blankline")) - htMakeDoneButton('"Continue",'d01gafGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -d01gafGen htPage == - n := htpProperty(htPage,'n) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - while y repeat - right := STRCONC ((first y).1," ") - y := rest y - left := STRCONC ((first y).1," ") - y := rest y - reallist := [left,:reallist] - imaglist := [right,:imaglist] - realstring := bcwords2liststring reallist - imagstring := bcwords2liststring imaglist - linkGen STRCONC ('"d01gaf([",realstring,"],[",imagstring,"],",STRINGIMAGE n,",", STRINGIMAGE ifail,")") - -d01fcf() == - htInitPage('"D01FCF - Multi-dimensional adaptive quadrature over hyper-rectangle",nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain PI (PositiveInteger)) - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXd01fcf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d01fcf| '|NagIntegrationPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "Evaluates the multi-dimensional integral ") - (text . "\center{\htbitmap{d01fcf}}") - (text . "with constant finite limits, using an adaptive subdivision ") - (text . "strategy.") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Number of dimensions n in the integral, 2 \htbitmap{less=} ") - (text . "{\it NDIM} \htbitmap{less=} 15: ") - (text . "\newline\tab{2} ") - (bcStrings (6 4 ndim F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Enter the integrand {\it f} in terms of X[1]...X[n]: ") - (text . "\newline ") - (bcStrings (58 "4.0*X[1]*X[3]*X[3]*exp(2.0*X[1]*X[3])/((1.0+X[2]+X[4])**2)" expression EM)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") - (text . "\newline Minimum number of evaluations: ") - (text . "\tab{32} \menuitemstyle{}\tab{34} ") - (text . "Maximum number of evaluations: ") - (text . "\newline\tab{2} ") - (bcStrings (10 1000 minpts PI)) - (text . "\tab{34} ") - (bcStrings (10 5700 maxpts PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Relative accuracy required:") - (text . "\newline\tab{2} ") - (bcStrings (10 "0.0001" eps F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Dimension of workspace array: ") - (text . "\newline\tab{2} ") - (bcStrings (10 606 lenwrk 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", 'd01fcfSolve) - htShowPage() - - -d01fcfSolve htPage == - ndim := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ndim) - objValUnwrap htpLabelSpadValue(htPage, 'ndim) - expression := htpLabelInputString(htPage,'expression) - minpts := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'minpts) - objValUnwrap htpLabelSpadValue(htPage, 'minpts) - maxpts := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'maxpts) - objValUnwrap htpLabelSpadValue(htPage, 'maxpts) - eps := htpLabelInputString(htPage,'eps) - lenwrk := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lenwrk) - objValUnwrap htpLabelSpadValue(htPage, 'lenwrk) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - ndim = '4 => d01fcfDefaultSolve(htPage,minpts,maxpts,eps,lenwrk,expression,ifail) - labelList := - "append"/[f(i) for i in 1..ndim] where f(i) == - prefix := ('"\newline \tab{2} ") - post := ('"\tab{32} ") - rnam := INTERN STRCONC ('"a",STRINGIMAGE i) - inam := INTERN STRCONC ('"b",STRINGIMAGE i) - [['text,:prefix],['bcStrings,[10, 0.0, rnam, 'P]], - ['text,:post],['bcStrings,[10, 1.0, inam, 'P]]] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain PI (PositiveInteger))), - :labelList] - page := htInitPage('"D01FCF - Multi-dimensional adaptive quadrature over hyper-rectangle",nil) - htSay '"Please enter the limits of integration:- " - htSay '"\blankline " - htSay '"\menuitemstyle{}\tab{2} Lower limits: \tab{30} " - htSay '"\menuitemstyle{}\tab{32} Upper limits: " - htMakePage equationPart - htMakeDoneButton('"Continue",'d01fcfGen) - htpSetProperty(page,'ndim,ndim) - htpSetProperty(page,'expression,expression) - htpSetProperty(page,'minpts,minpts) - htpSetProperty(page,'maxpts,maxpts) - htpSetProperty(page,'eps,eps) - htpSetProperty(page,'lenwrk,lenwrk) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -d01fcfDefaultSolve(htPage,minpts,maxpts,eps,lenwrk,expression,ifail) == - ndim := '4 - page := htInitPage('"D01FCF - Multi-dimensional adaptive quadrature over hyper-rectangle",nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\newline ") - (text . "Please enter the limits of integration:- ") - (text . "\blankline ") - (text . "\newline \menuitemstyle{} \tab{2} ") - (text . "Lower limits: \tab{30} ") - (text . "\menuitemstyle{} \tab{32} Upper limits: ") - (text . "\newline \tab{2} ") - (bcStrings (10 "0.0" a1 F)) - (text . "\tab{32} ") - (bcStrings (10 "1.0" b1 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.0" a2 F)) - (text . "\tab{32} ") - (bcStrings (10 "1.0" b2 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.0" a3 F)) - (text . "\tab{32} ") - (bcStrings (10 "1.0" b3 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.0" a4 F)) - (text . "\tab{32} ") - (bcStrings (10 "1.0" b4 F)) - (text . "\newline ") - (text . "\blankline")) - htMakeDoneButton('"Continue",'d01fcfGen) - htpSetProperty(page,'ndim,ndim) - htpSetProperty(page,'expression,expression) - htpSetProperty(page,'minpts,minpts) - htpSetProperty(page,'maxpts,maxpts) - htpSetProperty(page,'eps,eps) - htpSetProperty(page,'lenwrk,lenwrk) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -d01fcfGen htPage == - ndim := htpProperty(htPage,'ndim) - minpts := htpProperty(htPage,'minpts) - maxpts := htpProperty(htPage,'maxpts) - eps := htpProperty(htPage,'eps) - lenwrk := htpProperty(htPage,'lenwrk) - expression := htpProperty(htPage,'expression) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - while y repeat - right := (first y).1 - y := rest y - left := (first y).1 - y := rest y - reallist := [left,:reallist] - imaglist := [right,:imaglist] - astring := bcwords2liststring reallist - bstring := bcwords2liststring imaglist - prefix := STRCONC("d01fcf(",STRINGIMAGE ndim,", [",astring,"],[",bstring,"], ") - middle := STRCONC(STRINGIMAGE maxpts,", ",eps," ,",STRINGIMAGE lenwrk," ,") - middle := STRCONC(middle,STRINGIMAGE minpts," ,",STRINGIMAGE ifail," ,") - end := STRCONC("(",expression,"::Expression Float) :: ASP4(FUNCTN))") - linkGen STRCONC(prefix,middle,end) - - -d01gbf() == - htInitPage('"D01GBF - Multi-dimensional quadrature over hyper-rectangle, Monte Carlo method",nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain PI (PositiveInteger)) - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXd01gbf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d01gbf| '|NagIntegrationPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "Evaluates the multidimensional integral ") - (text . "\center{\htbitmap{d01fcf}} with constant finite limits, ") - (text . "using an adaptive Monte-Carlo method;") - (text . " the routine is suitable for low accuracy work. ") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Number of dimensions n in the integral, {\it NDIM}:") - (text . "\newline\tab{2} ") - (bcStrings (6 4 ndim F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Enter the integrand {\it f} in terms of X[1]...X[n]: ") - (text . "\newline ") - (bcStrings (60 "4.0*X[1]*X[3]*X[3]*exp(2.0*X[1]*X[3])/((1.0+X[2]+X[4])**2)" expression EM)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") - (text . "\newline Minimum number of FUNCTN calls: ") - (text . "\tab{32} \menuitemstyle{}\tab{34} ") - (text . "Maximum number of FUNCTN calls: ") - (text . "\newline\tab{2} ") - (bcStrings (10 1000 mincls PI)) - (text . "\tab{34} ") - (bcStrings (10 20000 maxcls PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Relative accuracy required:") - (text . "\newline\tab{2} ") - (bcStrings (10 "0.01" eps F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Dimension of workspace array: ") - (text . "\newline\tab{2} ") - (bcStrings (10 500 lenwrk 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", 'd01gbfSolve) - htShowPage() - - -d01gbfSolve htPage == - ndim := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ndim) - objValUnwrap htpLabelSpadValue(htPage, 'ndim) - expression := htpLabelInputString(htPage,'expression) - mincls := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'mincls) - objValUnwrap htpLabelSpadValue(htPage, 'mincls) - maxcls := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'maxcls) - objValUnwrap htpLabelSpadValue(htPage, 'maxcls) - eps := htpLabelInputString(htPage,'eps) - lenwrk := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lenwrk) - objValUnwrap htpLabelSpadValue(htPage, 'lenwrk) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - ndim = '4 => d01gbfDefaultSolve(htPage,mincls,maxcls,eps,lenwrk,expression,ifail) - labelList := - "append"/[f(i) for i in 1..ndim] where f(i) == - prefix := ('"\newline \tab{2} ") - post := ('"\tab{32} ") - rnam := INTERN STRCONC ('"a",STRINGIMAGE i) - inam := INTERN STRCONC ('"b",STRINGIMAGE i) - [['text,:prefix],['bcStrings,[10, 0.0, rnam, 'P]], - ['text,:post],['bcStrings,[10, 1.0, inam, 'P]]] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain PI (PositiveInteger))), - :labelList] - page := htInitPage('"D01GBF - Multi-dimensional quadrature over hyper-rectangle, Monte Carlo method",nil) - htSay '"Please enter the limits of integration:- " - htSay '"\blankline " - htSay '"\menuitemstyle{}\tab{2} Lower limits: \tab{30} " - htSay '"\menuitemstyle{}\tab{32} Upper limits: " - htMakePage equationPart - htMakeDoneButton('"Continue",'d01gbfGen) - htpSetProperty(page,'ndim,ndim) - htpSetProperty(page,'expression,expression) - htpSetProperty(page,'mincls,mincls) - htpSetProperty(page,'maxcls,maxcls) - htpSetProperty(page,'eps,eps) - htpSetProperty(page,'lenwrk,lenwrk) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -d01gbfDefaultSolve(htPage,mincls,maxcls,eps,lenwrk,expression,ifail) == - ndim := '4 - page := htInitPage('"D01GBF - Multi-dimensional quadrature over hyper-rectangle, Monte Carlo method",nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\newline ") - (text . "Please enter the limits of integration:- ") - (text . "\blankline ") - (text . "\newline \menuitemstyle{} \tab{2} ") - (text . "Lower limits: \tab{30} ") - (text . "\menuitemstyle{} \tab{32} Upper limits: ") - (text . "\newline \tab{2} ") - (bcStrings (10 "0.0" a1 F)) - (text . "\tab{32} ") - (bcStrings (10 "1.0" b1 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.0" a2 F)) - (text . "\tab{32} ") - (bcStrings (10 "1.0" b2 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.0" a3 F)) - (text . "\tab{32} ") - (bcStrings (10 "1.0" b3 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.0" a4 F)) - (text . "\tab{32} ") - (bcStrings (10 "1.0" b4 F)) - (text . "\newline ") - (text . "\blankline")) - htMakeDoneButton('"Continue",'d01gbfGen) - htpSetProperty(page,'ndim,ndim) - htpSetProperty(page,'expression,expression) - htpSetProperty(page,'mincls,mincls) - htpSetProperty(page,'maxcls,maxcls) - htpSetProperty(page,'eps,eps) - htpSetProperty(page,'lenwrk,lenwrk) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - - - -d01gbfGen htPage == - ndim := htpProperty(htPage,'ndim) - mincls := htpProperty(htPage,'mincls) - maxcls := htpProperty(htPage,'maxcls) - eps := htpProperty(htPage,'eps) - lenwrk := htpProperty(htPage,'lenwrk) - expression := htpProperty(htPage,'expression) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - while y repeat - right := (first y).1 - y := rest y - left := (first y).1 - y := rest y - reallist := [left,:reallist] - imaglist := [right,:imaglist] - astring := bcwords2liststring reallist - bstring := bcwords2liststring imaglist - prefix := STRCONC("d01gbf(",STRINGIMAGE ndim,", [",astring,"],[",bstring,"], ") - middle := STRCONC(STRINGIMAGE maxcls,", ",eps," ,",STRINGIMAGE lenwrk," ,") - middle := STRCONC(middle,STRINGIMAGE mincls," ,[[0.0 for i in 1..") - middle := STRCONC(middle,STRINGIMAGE lenwrk,"]],",STRINGIMAGE ifail," ,") - end := STRCONC("(",expression,"::Expression Float) :: ASP4(FUNCTN))") - linkGen STRCONC(prefix,middle,end) - -d01bbf() == - htInitPage('"D01BBF - Weights and abscissae for Gaussian quadrature rules",nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain PI (PositiveInteger)) - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXd01bbf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d01bbf| '|NagIntegrationPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "Returns the weights and abscissae appropriate to a Gaussian ") - (text . "quadrature formula with a specified number of abscissae. ") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Enter the D01XXX subroutine: ") - (radioButtons gtype - ("" " D01BAZ" gZero) - ("" " D01BAY" gOne) - ("" " D01BAX" gTwo) - ("" " D01BAW" gThree)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") - (text . "\newline {\em Lower} bound of the interval: ") - (text . "\tab{32} \menuitemstyle{}\tab{34} ") - (text . "{\em Upper} bound:") - (text . "\newline\tab{2} ") - (bcStrings (20 "0.0" a F)) - (text . "\tab{34} ") - (bcStrings (20 "1.0" b EM)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Type of weights for Gauss-Laguerre or Gauss-Hermite quadrature:") - (radioButtons itype - ("" " adjusted weights" iOne) - ("" " normal weights" iZero)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "\newline Number of weights & abscissae to be used {\em n}:") - (text . "\newline\tab{2} ") - (bcStrings (10 "6" n 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", 'd01bbfGen) - htShowPage() - -d01bbfGen htPage == - sub := htpButtonValue(htPage,'gtype) - gtype := - sub = 'gZero => 0 - sub = 'gOne => 1 - sub = 'gTwo => 2 - 3 - a := htpLabelInputString(htPage,'a) - b := htpLabelInputString(htPage,'b) - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - wgts := htpButtonValue(htPage,'itype) - itype := - wgts = 'iOne => 1 - 0 - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => 1 - -1 - prefix := STRCONC("d01bbf(",a," ,",b," ,",STRINGIMAGE itype," ,") - end := STRCONC(STRINGIMAGE n," ,",STRINGIMAGE gtype," ,",STRINGIMAGE ifail,")") - linkGen STRCONC(prefix,end) -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/nag-d02.boot b/src/interp/nag-d02.boot new file mode 100644 index 00000000..69510bac --- /dev/null +++ b/src/interp/nag-d02.boot @@ -0,0 +1,2148 @@ +-- 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. + + +)package "BOOT" + +d02bbf() == + htInitPage('"D02BBF - ODEs, IVP, Runge-Kutta-Merson method, over a range, intermediate output",nil) + htMakePage '( + (domainConditions + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXd02bbf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d02bbf| '|NagOrdinaryDifferentialEquationsPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\newline ") + (text . "D02BBF integrates a system of {\it n} ordinary differential ") + (text . "equations, {\htbitmap{yi}}' = {\htbitmap{fi}}(x,y), for ") + (text . "{\it i} = 1,2,...,{\it n}, over a range with given initial ") + (text . "conditions using a Runge-Kutta-Merson method; the solution ") + (text . "may be output at specified points.") + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Initial value of {\it x}:") + (text . "\newline\tab{2} ") + (bcStrings (5 "0.0" x F)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "End of integration range {\it xend}:") + (text . "\newline\tab{2} ") + (bcStrings (5 "8.0" xend F)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Number of differential equations {\it n}:") + (text . "\newline\tab{2} ") + (bcStrings (5 3 n PI)) + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} ") + (text . "\newline Tolerance required {\it tol}: ") + (text . "\newline\tab{2} ") + (bcStrings (10 "0.0001" tol F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Error control indicator {\it irelab}:") + (radioButtons irelab + ("" " 0, mixed" mix) + ("" " 1, absolute" abs) + ("" " 2, relative" rel)) + (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", 'd02bbfSolve) + htShowPage() + +d02bbfSolve htPage == + x := htpLabelInputString(htPage,'x) + xend := htpLabelInputString(htPage,'xend) + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + tol := htpLabelInputString(htPage,'tol) + control := htpButtonValue(htPage,'irelab) + irelab := + control = 'mix => '0 + control = 'abs => '1 + '2 + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'minusOne => '-1 + '1 + n = '3 => d02bbfDefaultSolve(htPage,x,xend,tol,irelab,ifail) + funcList := + "append"/[fa(i) for i in 1..n] where fa(i) == + prefix := ('"\newline {\em Function ") + prefix := STRCONC(prefix,STRINGIMAGE i,'":} \space{1}") + funct := STRCONC ('"Y[",STRINGIMAGE i ,"]") + nam := INTERN STRCONC ('"n",STRINGIMAGE i) + [['text,:prefix],['bcStrings,[42, funct, nam, 'EM]]] + middle := ('"\blankline \menuitemstyle{} \tab{2} Enter the initial ") + middle := STRCONC(middle,'"values of \htbitmap{yi}: \newline \tab{2}") + yList := + "append"/[fb(i) for i in 1..n] where fb(i) == + ynam := INTERN STRCONC ('"u",STRINGIMAGE i) + [['bcStrings,[6, 0, ynam, 'F]]] + yList := [['text,:middle],:yList] + mid:= ('"\blankline \menuitemstyle{} \tab{2} Intermediate values of {\it x}") + mid := STRCONC(mid,'" at which \htbitmap{yi} is required: \newline \tab{2}") + vList := [['bcStrings,[30, "0", 'out, 'EM]]] + vList := [['text,:mid],:vList] + equationPart := [ + '(domainConditions + (isDomain EM $EmptyMode) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain I (Integer))), + :funcList,:yList,:vList] + page := htInitPage('"D02BBF - ODEs, IVP, Runge-Kutta-Merson method, over a range, intermediate output",nil) + htSay '"\menuitemstyle{}\tab{2} " + htSay '"Enter the functions (i.e. the derivatives) below " + htSay '"as functions of Y[1]...Y[n]: " + htSay '"\newline " + htMakePage equationPart + htMakeDoneButton('"Continue",'d02bbfGen) + htpSetProperty(page,'x,x) + htpSetProperty(page,'xend,xend) + htpSetProperty(page,'n,n) + htpSetProperty(page,'tol,tol) + htpSetProperty(page,'irelab,irelab) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +d02bbfDefaultSolve(htPage,x,xend,tol,irelab,ifail) == + n := '3 + page := htInitPage('"D02BBF - ODEs, IVP, Runge-Kutta-Merson method, over a range, intermediate output",nil) + htMakePage '( + (domainConditions + (isDomain EM $EmptyMode) + (isDomain F (Float)) + (isDomain I (Integer))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the functions (i.e. the derivatives) below ") + (text . "as functions of Y[1]...Y[n]: ") + (text . "\newline ") + (text . "\newline {\em Function 1:} \space{1}") + (bcStrings (44 "tan(Y[3])" f1 EM)) + (text . "\newline {\em Function 2:} \space{1}") + (bcStrings (44 "-0.032*tan(Y[3])/Y[2] -0.02*Y[2]/cos(Y[3])" f2 EM)) + (text . "\newline {\em Function 3:} \space{1}") + (bcStrings (44 "-0.032/(Y[2]**2)" f3 EM)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the initial values of \htbitmap{yi}:") + (text . "\newline \tab{2}") + (bcStrings (8 "0.0" y1 EM)) + (bcStrings (8 "0.5" y2 EM)) + (bcStrings (8 "\%pi*0.2" y3 EM)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Intermediate values of {\it x} at which \htbitmap{yi} is required:") + (text . "\newline \tab{2}") + (bcStrings (30 "1,2,3,4,5,6,7,8" out EM))) + htpSetProperty(page,'x,x) + htpSetProperty(page,'xend,xend) + htpSetProperty(page,'n,n) + htpSetProperty(page,'tol,tol) + htpSetProperty(page,'irelab,irelab) + htpSetProperty(page,'ifail,ifail) + htMakeDoneButton('"Continue",'d02bbfGen) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +d02bbfGen htPage == + x := htpProperty(htPage, 'x) + xend := htpProperty(htPage, 'xend) + n := htpProperty(htPage, 'n) + tol := htpProperty(htPage, 'tol) + irelab := htpProperty(htPage, 'irelab) + ifail := htpProperty(htPage, 'ifail) + alist := htpInputAreaAlist htPage + y := alist + outp := ((first y).1) + oList := [outp,:oList] + y := rest y + ostring := bcwords2liststring oList + -- This is distictly horrible! OUTP is a comma-seperated string so we + -- count up the commas to see how many elements it has. We return this + -- quantity plus 1 since the ASP OUTPUT is always called at least once. + numberOfPoints := + ZEROP LENGTH(outp) => 1 + 2+COUNT(CHARACTER(44),outp) + for i in 1..n repeat + ytemp := STRCONC((first y).1," ") + yList := [ytemp,:yList] + y := rest y + ystring := bcwords2liststring yList + while y repeat + f := STRCONC((first y).1," ") + fList := [f,:fList] + y := rest y + fstring := bcwords2liststring fList + prefix := STRCONC("d02bbf(", xend,", ", STRINGIMAGE numberOfPoints, ", ",STRINGIMAGE n,", ",STRINGIMAGE irelab) + prefix := STRCONC(prefix,", ",x,", [", ystring,"],",tol) + prefix := STRCONC(prefix,", ",STRINGIMAGE ifail,",(") + end := STRCONC(fstring,"::Vector Expression Float)::ASP7('FCN),(",ostring) + end := STRCONC(end,"::Vector MachineFloat)::ASP8('OUTPUT))") + linkGen STRCONC(prefix,end) + +d02bhf() == + htInitPage('"D02BHF - ODEs, IVP, Runge-Kutta-Merson method, until function of solution is zero",nil) + htMakePage '( + (domainConditions + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXd02bhf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d02bhf| '|NagOrdinaryDifferentialEquationsPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\newline ") + (text . "D02BHF integrates a system of {\it n} ordinary differential ") + (text . "equations, {\htbitmap{yi}}' = {\htbitmap{fi}}(x,y), for ") + (text . "{\it i} = 1,2,...,{\it n}, over a range with given initial ") + (text . "conditions using a Runge-Kutta-Merson method until a specified ") + (text . "function {\em g(x,y)} of the solution is zero. ") + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Initial value of {\it x}:") + (text . "\newline\tab{2} ") + (bcStrings (5 "0.0" x F)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "End of integration range {\it xend}:") + (text . "\newline\tab{2} ") + (bcStrings (5 "10.0" xend F)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Number of differential equations {\it n}:") + (text . "\newline\tab{2} ") + (bcStrings (5 3 n PI)) + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} ") + (text . "\newline Tolerance required {\it tol}: ") + (text . "\newline\tab{2} ") + (bcStrings (10 "0.0001" tol F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Error control indicator {\it irelab}:") + (radioButtons irelab + ("" " 0, mixed" mix) + ("" " 1, absolute" abs) + ("" " 2, relative" rel)) + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} ") + (text . "\newline Upper bound on size of the interval {\it hmax}: ") + (text . "\newline\tab{2} ") + (bcStrings (10 "0.0" hmax 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", 'd02bhfSolve) + htShowPage() + +d02bhfSolve htPage == + x := htpLabelInputString(htPage,'x) + xend := htpLabelInputString(htPage,'xend) + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + tol := htpLabelInputString(htPage,'tol) + control := htpButtonValue(htPage,'irelab) + irelab := + control = 'mix => '0 + control = 'abs => '1 + '2 + hmax := htpLabelInputString(htPage,'hmax) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + n = '3 => d02bhfDefaultSolve(htPage,x,xend,tol,irelab,hmax,ifail) + funcList := + "append"/[fa(i) for i in 1..n] where fa(i) == + prefix := ('"\newline {\em Function ") + prefix := STRCONC(prefix,STRINGIMAGE i,'":} \space{1}") + funct := STRCONC ('"Y[",STRINGIMAGE i ,"]") + nam := INTERN STRCONC ('"n",STRINGIMAGE i) + [['text,:prefix],['bcStrings,[42, funct, nam, 'EM]]] + middle := ('"\blankline \menuitemstyle{} \tab{2} Enter the initial ") + middle := STRCONC(middle,'"values of \htbitmap{yi}: \newline ") + yList := + "append"/[fb(i) for i in 1..n] where fb(i) == + ynam := INTERN STRCONC ('"u",STRINGIMAGE i) + [['bcStrings,[6, 0, ynam, 'F]]] + yList := [['text,:middle],:yList] + mid:= ('"\blankline \menuitemstyle{} \tab{2} Enter the function below ") + mid := STRCONC(mid,'"{\em g(x,y)}: \newline ") + vList := [['bcStrings,[30, '"Y[1]", 'g, 'EM]]] + vList := [['text,:mid],:vList] + equationPart := [ + '(domainConditions + (isDomain EM $EmptyMode) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain I (Integer))), + :funcList,:yList,:vList] + page := htInitPage('"D02BHF - ODEs, IVP, Runge-Kutta-Merson method, until function of solution is zero",nil) + htSay '"\menuitemstyle{}\tab{2} " + htSay '"Enter the functions (i.e. the derivatives) below \htbitmap{fi} " + htSay '"as functions of Y[1]...Y[n]: " + htSay '"\newline " + htMakePage equationPart + htMakeDoneButton('"Continue",'d02bhfGen) + htpSetProperty(page,'x,x) + htpSetProperty(page,'xend,xend) + htpSetProperty(page,'n,n) + htpSetProperty(page,'tol,tol) + htpSetProperty(page,'irelab,irelab) + htpSetProperty(page,'hmax,hmax) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +d02bhfDefaultSolve(htPage,x,xend,tol,irelab,hmax,ifail) == + n := '3 + page := htInitPage('"D02BHF - ODEs, IVP, Runge-Kutta-Merson method, until function of solution is zero",nil) + htMakePage '( + (domainConditions + (isDomain EM $EmptyMode) + (isDomain F (Float)) + (isDomain I (Integer))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the functions (i.e. the derivatives) below \htbitmap{fi} ") + (text . "as functions of Y[1]...Y[n]: ") + (text . "\newline {\em Function 1:} \space{1}") + (bcStrings (44 "tan(Y[3])" f1 EM)) + (text . "\newline {\em Function 2:} \space{1}") + (bcStrings (44 "-0.032*tan(Y[3])/Y[2] -0.02*Y[2]/cos(Y[3])" f2 EM)) + (text . "\newline {\em Function 3:} \space{1}") + (bcStrings (44 "-0.032/(Y[2]**2)" f3 EM)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the initial values of \htbitmap{yi}:") + (text . "\newline ") + (bcStrings (8 "0.5" y1 EM)) + (bcStrings (8 "0.5" y2 EM)) + (bcStrings (8 "\%pi*0.2" y3 EM)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the function below {\em g(x,y)}: ") + (text . "\newline ") + (bcStrings (30 "Y[1]" g EM))) + htpSetProperty(page,'x,x) + htpSetProperty(page,'xend,xend) + htpSetProperty(page,'n,n) + htpSetProperty(page,'tol,tol) + htpSetProperty(page,'irelab,irelab) + htpSetProperty(page,'hmax,hmax) + htpSetProperty(page,'ifail,ifail) + htMakeDoneButton('"Continue",'d02bhfGen) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +d02bhfGen htPage == + x := htpProperty(htPage, 'x) + xend := htpProperty(htPage, 'xend) + n := htpProperty(htPage, 'n) + tol := htpProperty(htPage, 'tol) + irelab := htpProperty(htPage, 'irelab) + hmax := htpProperty(htPage, 'hmax) + ifail := htpProperty(htPage, 'ifail) + alist := htpInputAreaAlist htPage + y := alist + g := ((first y).1) + y := rest y + for i in 1..n repeat + ytemp := STRCONC((first y).1," ") + yList := [ytemp,:yList] + y := rest y + ystring := bcwords2liststring yList + while y repeat + f := STRCONC((first y).1," ") + fList := [f,:fList] + y := rest y + fstring := bcwords2liststring fList + prefix := STRCONC("d02bhf(", xend,", ",STRINGIMAGE n,", ",STRINGIMAGE irelab) + mid := STRCONC(", ",hmax,", ",x,", [", ystring,"],") + mid := STRCONC(mid,tol,", ",STRINGIMAGE ifail,",(",g) + mid := STRCONC(mid,"::Expression Float)::ASP9('G),(") + end := STRCONC(fstring,"::Vector Expression Float)::ASP7('FCN))") + linkGen STRCONC(prefix,mid,end) + + +d02cjf() == + htInitPage('"D02CJF - ODEs, IVP, Adams method, until function of solution is zero, intermediate output",nil) + htMakePage '( + (domainConditions + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXd02cjf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d02cjf| '|NagOrdinaryDifferentialEquationsPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\newline ") + (text . "D02CJF integrates a system of {\it n} ordinary differential ") + (text . "equations, {\htbitmap{yi}}' = {\htbitmap{fi}}(x,y), for ") + (text . "{\it i} = 1,2,...,{\it n}, over a range with given initial ") + (text . "conditions using an Adams method until a specified ") + (text . "function {\em g(x,y)} of the solution is zero; the solution may ") + (text . "be output at specified points. \blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Initial value of {\it x}:") + (text . "\newline\tab{2} ") + (bcStrings (5 "0.0" x F)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "End of integration range {\it xend}:") + (text . "\newline\tab{2} ") + (bcStrings (5 "10.0" xend F)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Number of differential equations {\it n}:") + (text . "\newline\tab{2} ") + (bcStrings (5 3 n PI)) + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} ") + (text . "\newline Tolerance required {\it tol}: ") + (text . "\newline\tab{2} ") + (bcStrings (10 "0.0001" tol F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Type of error test used {\it relabs}:") + (radioButtons relabs + ("" " D, default (mixed)" mix) + ("" " A, absolute" abs) + ("" " R, relative" rel)) + (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", 'd02cjfSolve) + htShowPage() + +d02cjfSolve htPage == + x := htpLabelInputString(htPage,'x) + xend := htpLabelInputString(htPage,'xend) + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + tol := htpLabelInputString(htPage,'tol) + control := htpButtonValue(htPage,'relabs) + relabs := + control = 'mix => '"D" + control = 'abs => '"A" + '"R" + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + n = '3 => d02cjfDefaultSolve(htPage,x,xend,tol,relabs,ifail) + funcList := + "append"/[fa(i) for i in 1..n] where fa(i) == + prefix := ('"\newline {\em Function ") + prefix := STRCONC(prefix,STRINGIMAGE i,'":} \space{1}") + funct := STRCONC ('"Y[",STRINGIMAGE i ,"]") + nam := INTERN STRCONC ('"n",STRINGIMAGE i) + [['text,:prefix],['bcStrings,[42, funct, nam, 'EM]]] + middle := ('"\blankline \menuitemstyle{} \tab{2} Enter the initial ") + middle := STRCONC(middle,'"values of \htbitmap{yi}: \newline ") + yList := + "append"/[fb(i) for i in 1..n] where fb(i) == + ynam := INTERN STRCONC ('"u",STRINGIMAGE i) + [['bcStrings,[6, 0, ynam, 'F]]] + yList := [['text,:middle],:yList] + mid:= ('"\blankline \menuitemstyle{} \tab{2} Intermediate values of {\it x}") + mid := STRCONC(mid,'" at which \htbitmap{yi} is required: \newline ") + vList := [['bcStrings,[30, "2,4", 'out, 'EM]]] + vList := [['text,:mid],:vList] + midd := ('"\blankline \menuitemstyle{} \tab{2} Enter the function below ") + midd := STRCONC(midd,'"{\em g(x,y)}: \newline ") + uList := [['bcStrings,[30, '"Y[1]", 'g, 'EM]]] + uList := [['text,:midd],:uList] + equationPart := [ + '(domainConditions + (isDomain EM $EmptyMode) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain I (Integer))), + :funcList,:yList,:vList,:uList] + page := htInitPage('"D02CJF - ODEs, IVP, Adams method, until function of solution is zero, intermediate output",nil) + htSay '"\menuitemstyle{}\tab{2} " + htSay '"Enter the functions (i.e. the derivatives) below \htbitmap{fi} " + htSay '"as functions of Y[1]...Y[n]: " + htSay '"\newline " + htMakePage equationPart + htMakeDoneButton('"Continue",'d02cjfGen) + htpSetProperty(page,'x,x) + htpSetProperty(page,'xend,xend) + htpSetProperty(page,'n,n) + htpSetProperty(page,'tol,tol) + htpSetProperty(page,'relabs,relabs) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +d02cjfDefaultSolve(htPage,x,xend,tol,relabs,ifail) == + n := '3 + page := htInitPage('"D02CJF - ODEs, IVP, Adams method, until function of solution is zero, intermediate output",nil) + htMakePage '( + (domainConditions + (isDomain EM $EmptyMode) + (isDomain F (Float)) + (isDomain I (Integer))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the functions (i.e. the derivatives) below \htbitmap{fi} ") + (text . "as functions of Y[1]...Y[n]: ") + (text . "\newline {\em Function 1:} \space{1}") + (bcStrings (44 "tan(Y[3])" f1 EM)) + (text . "\newline {\em Function 2:} \space{1}") + (bcStrings (44 "-0.032*tan(Y[3])/Y[2] -0.02*Y[2]/cos(Y[3])" f2 EM)) + (text . "\newline {\em Function 3:} \space{1}") + (bcStrings (44 "-0.032/(Y[2]**2)" f3 EM)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the initial values of \htbitmap{yi}:") + (text . "\newline ") + (bcStrings (8 "0.5" y1 EM)) + (bcStrings (8 "0.5" y2 EM)) + (bcStrings (8 "\%pi*0.2" y3 EM)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2} Intermediate") + (text . " values of {\it x} at which \htbitmap{yi} is required:") + (text . "\newline ") + (bcStrings (30 "2,4,6,8" out EM)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the function below {\em g(x,y)}: ") + (text . "\newline ") + (bcStrings (30 "Y[1]" g EM))) + htpSetProperty(page,'x,x) + htpSetProperty(page,'xend,xend) + htpSetProperty(page,'n,n) + htpSetProperty(page,'tol,tol) + htpSetProperty(page,'relabs,relabs) + htpSetProperty(page,'ifail,ifail) + htMakeDoneButton('"Continue",'d02cjfGen) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +d02cjfGen htPage == + x := htpProperty(htPage, 'x) + xend := htpProperty(htPage, 'xend) + n := htpProperty(htPage, 'n) + tol := htpProperty(htPage, 'tol) + relabs := htpProperty(htPage, 'relabs) + ifail := htpProperty(htPage, 'ifail) + alist := htpInputAreaAlist htPage + y := alist + g := ((first y).1) + y := rest y + outp := ((first y).1) + oList := [outp,:oList] + ostring := bcwords2liststring oList + -- This is distictly horrible! OUTP is a comma-seperated string so we + -- count up the commas to see how many elements it has. We return this + -- quantity plus 1 since the ASP OUTPUT is always called at least once. + numberOfPoints := + ZEROP LENGTH(outp) => 1 + 2+COUNT(CHARACTER(44),outp) + y := rest y + for i in 1..n repeat + ytemp := STRCONC((first y).1," ") + yList := [ytemp,:yList] + y := rest y + ystring := bcwords2liststring yList + while y repeat + f := STRCONC((first y).1," ") + fList := [f,:fList] + y := rest y + fstring := bcwords2liststring fList + prefix := STRCONC("d02cjf(",xend,", ",STRINGIMAGE numberOfPoints ,", ", STRINGIMAGE n,", ",tol,",_"",relabs) + mid := STRCONC("_", ",x ,", [", ystring,"],",STRINGIMAGE ifail) + mid := STRCONC(mid,",(",g,"::Expression Float)::ASP9('G),(",fstring) + end := STRCONC("::Vector Expression Float)::ASP7('FCN),(",ostring) + end := STRCONC(end,"::Vector MachineFloat)::ASP8('OUTPUT))") + linkGen STRCONC(prefix,mid,end) + + + +d02ejf() == + htInitPage('"D02EJF - ODEs, stiff IVP, BDF method, until function of solution is zero, intermediate output",nil) + htMakePage '( + (domainConditions + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXd02ejf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d02ejf| '|NagOrdinaryDifferentialEquationsPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\newline ") + (text . "D02EJF integrates a system of {\em n} ordinary differential ") + (text . "equations, {\htbitmap{yi}}' = {\htbitmap{fi}}(x,y), for {\it i} ") + (text . "= 1,,2,...,{\it n}, over a range with given initial conditions") + (text . " using backward differentiation formulae until a specified ") + (text . "function {\em g(x,y)} of the solution is zero; the solution may ") + (text . "be output at specified points. \blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Initial value of {\it x}:") + (text . "\newline\tab{2} ") + (bcStrings (5 "0.0" x F)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "End of integration range {\it xend}:") + (text . "\newline\tab{2} ") + (bcStrings (5 "10.0" xend F)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Number of differential equations {\it n}:") + (text . "\newline\tab{2} ") + (bcStrings (5 3 n PI)) + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} ") + (text . "\newline Tolerance required {\it tol}: ") + (text . "\newline\tab{2} ") + (bcStrings (10 "0.0001" tol F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Type of error test used {\it relabs}:") + (radioButtons relabs + ("" " D, default (mixed)" mix) + ("" " A, absolute" abs) + ("" " R, relative" rel)) + (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", 'd02ejfSolve) + htShowPage() + +d02ejfSolve htPage == + x := htpLabelInputString(htPage,'x) + xend := htpLabelInputString(htPage,'xend) + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + tol := htpLabelInputString(htPage,'tol) + control := htpButtonValue(htPage,'relabs) + relabs := + control = 'mix => '"D" + control = 'abs => '"A" + '"R" + iw := (n + 12) * n + 50 + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + n = '3 => d02ejfDefaultSolve(htPage,x,xend,tol,relabs,iw,ifail) + funcList := + "append"/[fa(i) for i in 1..n] where fa(i) == + prefix := ('"\newline {\em Function ") + prefix := STRCONC(prefix,STRINGIMAGE i,'":} \space{1}") + funct := STRCONC ('"Y[",STRINGIMAGE i ,"]") + nam := INTERN STRCONC ('"n",STRINGIMAGE i) + [['text,:prefix],['bcStrings,[42, funct, nam, 'EM]]] + middle := ('"\blankline \menuitemstyle{} \tab{2} Enter the initial ") + middle := STRCONC(middle,'"values of \htbitmap{yi}: \newline ") + yList := + "append"/[fb(i) for i in 1..n] where fb(i) == + ynam := INTERN STRCONC ('"u",STRINGIMAGE i) + [['bcStrings,[6, 0, ynam, 'F]]] + yList := [['text,:middle],:yList] + mid:= ('"\blankline \menuitemstyle{} \tab{2} Intermediate values of {\it x}") + mid := STRCONC(mid,'" at which \htbitmap{yi} is required: \newline ") + vList := [['bcStrings,[30, "2,4,6,8", 'out, 'EM]]] + vList := [['text,:mid],:vList] + midd := ('"\blankline \menuitemstyle{} \tab{2} Enter the function below ") + midd := STRCONC(midd,'"{\em g(x,y)}: \newline ") + uList := [['bcStrings,[30, '"Y[1]", 'g, 'EM]]] + uList := [['text,:midd],:uList] + equationPart := [ + '(domainConditions + (isDomain EM $EmptyMode) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain I (Integer))), + :funcList,:yList,:vList,:uList] + page := htInitPage('"D02EJF - ODEs, stiff IVP, BDF method, until function of solution is zero, intermediate output",nil) + htSay '"\menuitemstyle{}\tab{2} " + htSay '"Enter the functions (i.e. the derivatives) below \htbitmap{fi} " + htSay '"as functions of Y[1]...Y[n]: " + htSay '"\newline " + htMakePage equationPart + htSay '"\blankline {\em Note:} PEDERV is automatically generated using the vector " + htSay '"of derivatives given above. " + htMakeDoneButton('"Continue",'d02ejfGen) + htpSetProperty(page,'x,x) + htpSetProperty(page,'xend,xend) + htpSetProperty(page,'n,n) + htpSetProperty(page,'tol,tol) + htpSetProperty(page,'relabs,relabs) + htpSetProperty(page,'iw,iw) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +d02ejfDefaultSolve(htPage,x,xend,tol,relabs,iw,ifail) == + n := '3 + page := htInitPage('"D02EJF - ODEs, stiff IVP, BDF method, until function of solution is zero, intermediate output",nil) + htMakePage '( + (domainConditions + (isDomain EM $EmptyMode) + (isDomain F (Float)) + (isDomain I (Integer))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the functions (i.e. the derivatives) below \htbitmap{fi} ") + (text . "as functions of Y[1]...Y[n]: ") + (text . "\newline {\em Function 1:} \space{1}") + (bcStrings (44 "-0.04*Y[1]+1.0E4*Y[2]*Y[3]" f1 EM)) + (text . "\newline {\em Function 2:} \space{1}") + (bcStrings (44 "0.04*Y[1]-1.0E4*Y[2]*Y[3]-3.0E7*Y[2]*Y[2]" f2 EM)) + (text . "\newline {\em Function 3:} \space{1}") + (bcStrings (44 "3.0E7*Y[2]*Y[2]" f3 EM)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the initial values of \htbitmap{yi}:") + (text . "\newline ") + (bcStrings (8 "1.0" y1 EM)) + (bcStrings (8 "0.0" y2 EM)) + (bcStrings (8 "0.0" y3 EM)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2} Intermediate") + (text . " values of {\it x} at which \htbitmap{yi} is required:") + (text . "\newline ") + (bcStrings (30 "2,4,6,8" out EM)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the function below {\em g(x,y)}: ") + (text . "\newline ") + (bcStrings (30 "Y[1]-0.9" g EM)) + (text . "\blankline ") + (text . "{\em Note:} PEDERV is automatically generated using the vector ") + (text . "of derivatives given above. ")) + htpSetProperty(page,'x,x) + htpSetProperty(page,'xend,xend) + htpSetProperty(page,'n,n) + htpSetProperty(page,'tol,tol) + htpSetProperty(page,'relabs,relabs) + htpSetProperty(page,'iw,iw) + htpSetProperty(page,'ifail,ifail) + htMakeDoneButton('"Continue",'d02ejfGen) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +d02ejfGen htPage == + x := htpProperty(htPage, 'x) + xend := htpProperty(htPage, 'xend) + n := htpProperty(htPage, 'n) + tol := htpProperty(htPage, 'tol) + relabs := htpProperty(htPage, 'relabs) + iw := htpProperty(htPage, 'iw) + ifail := htpProperty(htPage, 'ifail) + alist := htpInputAreaAlist htPage + y := alist + g := ((first y).1) + y := rest y + outp := ((first y).1) + oList := [outp,:oList] + ostring := bcwords2liststring oList + -- This is distictly horrible! OUTP is a comma-seperated string so we + -- count up the commas to see how many elements it has. We return this + -- quantity plus 1 since the ASP OUTPUT is always called at least once. + numberOfPoints := + ZEROP LENGTH(outp) => 1 + 2+COUNT(CHARACTER(44),outp) + y := rest y + for i in 1..n repeat + ytemp := STRCONC((first y).1," ") + yList := [ytemp,:yList] + y := rest y + ystring := bcwords2liststring yList + while y repeat + f := STRCONC((first y).1," ") + fList := [f,:fList] + y := rest y + fstring := bcwords2liststring fList + prefix := STRCONC("d02ejf(",xend,", ",STRINGIMAGE numberOfPoints,", ", STRINGIMAGE n,",_"",relabs,"_", ") + mid:=STRCONC(STRINGIMAGE iw,", ",x ,", [", ystring,"], ",tol,", ") + mid := STRCONC(mid,STRINGIMAGE ifail,",(",g,"::Expression Float)::ASP9(G),(") + end := STRCONC(fstring,"::Vector Expression Float)::ASP7('FCN),(",fstring) + end := STRCONC(end,"::Vector Expression Float)::ASP31('PEDERV),(",ostring) + end := STRCONC(end,"::Vector MachineFloat)::ASP8('OUTPUT))") + linkGen STRCONC(prefix,mid,end) + +d02gaf() == + htInitPage('"D02GAF - ODEs, boundary value problem, finite difference technique with deferred correction, simple nonlinear problem", nil) + htMakePage '( + (domainConditions + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXd02gaf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d02gaf| '|NagOrdinaryDifferentialEquationsPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\newline ") + (text . "D02GAF solves a two-point boundary value problem for a system ") + (text . "of n ODEs \center{\htbitmap{d02gaf},} for i = 1,2,...,n, on ") + (text . "the range [a,b] with assigned boundary conditions using a ") + (text . "deferred correction technique and a Newton iteration; ") + (text . "the solution is computed on a mesh. ") + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the number of equations in the system {\it n}:") + (text . "\newline\tab{2} ") + (bcStrings (5 3 n PI)) + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} ") + (text . "\newline Left hand boundary point {\it a}: ") + (text . "\tab{32} \menuitemstyle{}\tab{34} ") + (text . "Right hand boundary {\it b}:") + (text . "\newline\tab{2} ") + (bcStrings (10 "0.0" a F)) + (text . "\tab{34} ") + (bcStrings (10 "10.0" b F)) + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} ") + (text . "\newline Max number of mesh points {\it mnp}:") + (text . "\tab{32} \menuitemstyle{}\tab{34} ") + (text . "Number of points {\it np} ({\it np} = 0 or {\it np} ") + (text . "\htbitmap{great=} 4): ") + (text . "\newline\tab{2} ") + (bcStrings (10 64 mnp PI)) + (text . "\tab{34} ") + (bcStrings (10 26 np PI)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Accuracy required {\it tol}:") + (text . "\newline\tab{2} ") + (bcStrings (10 "1.0e-3" tol F)) + (text . "\blankline ") + (text . "\newline \tab{2} ") + (text . "Ifail is input in three components: ") + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "{\it a} ") + (radioButtons afail + ("" " 0, hard failure" azero) + ("" " 1, soft failure" aone)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "{\it b} ") + (radioButtons bfail + ("" " 1, print error messages" bone) + ("" " 0, suppress error messages" bzero)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "{\it c} ") + (radioButtons cfail + ("" " 1, print warning messages" cone) + ("" " 0, suppress warning messages" czero))) + htMakeDoneButton('"Continue", 'd02gafSolve) + htShowPage() + +d02gafSolve htPage == + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + a := htpLabelInputString(htPage,'a) + b := htpLabelInputString(htPage,'b) + mnp := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'mnp) + objValUnwrap htpLabelSpadValue(htPage, 'mnp) + np := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'np) + objValUnwrap htpLabelSpadValue(htPage, 'np) + lw := mnp * (3*n*n + 6*n + 2) + 4*n*n + 4*n + liw := mnp * (2*n + 1) + n*n + 4*n + 2 + tol := htpLabelInputString(htPage,'tol) + aerror := htpButtonValue(htPage,'afail) + afail := + aerror = 'azero => '0 + '1 + berror := htpButtonValue(htPage,'bfail) + bfail := + berror = 'bone => '1 + '0 + cerror := htpButtonValue(htPage,'cfail) + cfail := + cerror = 'cone => '1 + '0 + ifail := 100*cfail + 10*bfail + afail + n = '3 => d02gafDefaultSolve(htPage,a,b,mnp,np,lw,liw,tol,ifail) + funcList := + "append"/[fa(i) for i in 1..n] where fa(i) == + prefix := ('"\newline {\em Function ") + prefix := STRCONC(prefix,STRINGIMAGE i,'":} \space{1}") + funct := STRCONC ('"Y[",STRINGIMAGE i ,"]") + nam := INTERN STRCONC ('"n",STRINGIMAGE i) + [['text,:prefix],['bcStrings,[42, funct, nam, 'EM]]] + middle := ('"\blankline \menuitemstyle{} \tab{2} Enter known or estimated ") + middle := STRCONC(middle,'"values of \htbitmap{yi} at a and b, ") + middle := STRCONC(middle,"{\it U(n,2)}. [\htbitmap{yi}(a) in the first ") + middle := STRCONC(middle,"column, \htbitmap{yi}(b) in the second.] ") + middle := STRCONC(middle,"\newline ") + uList := + "append"/[fb(i) for i in 1..n] where fb(i) == + labelList := + "append"/[fc(i,j) for j in 1..2] where fc(i,j) == + unam := INTERN STRCONC ('"u",STRINGIMAGE i,STRINGIMAGE j) + [['bcStrings,[6, 0, unam, 'F]]] + prefix := ('"\newline ") + labelList := [['text,:prefix],:labelList] + uList := [['text,:middle],:uList] + mid := ('"\blankline \menuitemstyle{} \tab{2} Enter {\it V(n,2)}. ") + mid := STRCONC(mid,'"If U(i,j) is known V(i,j) ") + mid := STRCONC(mid,'"= 0.0, else V(i,j) = 1.0. \newline ") + vList := + "append"/[fd(i) for i in 1..n] where fd(i) == + labelList := + "append"/[fe(i,j) for j in 1..2] where fe(i,j) == + vnam := INTERN STRCONC ('"v",STRINGIMAGE i,STRINGIMAGE j) + [['bcStrings,[6, 0, vnam, 'F]]] + prefix := ('"\newline ") + labelList := [['text,:prefix],:labelList] + vList := [['text,:mid],:vList] + xList := + "append"/[ff(i) for i in 1..mnp] where ff(i) == + xnam := INTERN STRCONC ('"x",STRINGIMAGE i) + [['bcStrings,[8, "0.0", xnam, 'F]]] + end := ('"\blankline \menuitemstyle{} \tab{2} Enter the initial mesh ") + end := STRCONC(end,'"{\it X(mnp)}: \newline ") + xList := [['text,:end],:xList] + equationPart := [ + '(domainConditions + (isDomain EM $EmptyMode) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain I (Integer))), + :funcList,:uList,:vList,:xList] + page := htInitPage('"D02GAF - ODEs, boundary value problem, finite difference technique with deferred correction, simple nonlinear problem", nil) + htSay '"\menuitemstyle{}\tab{2} " + htSay '"Enter the functions (i.e. the derivatives) below as functions of " + htSay '"Y[1]...Y[n]: " + htSay '"\newline " + htMakePage equationPart + htMakeDoneButton('"Continue",'d02gafGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'a,a) + htpSetProperty(page,'b,b) + htpSetProperty(page,'mnp,mnp) + htpSetProperty(page,'np,np) + htpSetProperty(page,'lw,lw) + htpSetProperty(page,'liw,liw) + htpSetProperty(page,'tol,tol) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +d02gafDefaultSolve(htPage,a,b,mnp,np,lw,liw,tol,ifail) == + n := '3 + page := htInitPage('"D02GAF - ODEs, boundary value problem, finite difference technique with deferred correction, simple nonlinear problem", nil) + htMakePage '( + (domainConditions + (isDomain EM $EmptyMode) + (isDomain F (Float)) + (isDomain I (Integer))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the functions (i.e. the derivatives) below ") + (text . "as functions of Y[1]...Y[n]: ") + (text . "\newline ") + (text . "\newline {\em Function 1:} \space{1}") + (bcStrings (42 "Y[2]" f1 EM)) + (text . "\newline {\em Function 2:} \space{1}") + (bcStrings (42 "Y[3]" f2 EM)) + (text . "\newline {\em Function 3:} \space{1}") + (bcStrings (42 "-Y[1]*Y[3]-0.2*(1-Y[2]*Y[2])" f3 EM)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter known or estimated values of \htbitmap{yi} at a and b,") + (text . " {\it U(n,2)}. ") + (text . " [\htbitmap{yi}(a) in the first column, \htbitmap{yi}(b) ") + (text . "in the second.] \newline ") + (bcStrings (6 "0" u11 F)) + (bcStrings (6 "10" u21 F)) + (text . "\newline ") + (bcStrings (6 "0" u12 F)) + (bcStrings (6 "1" u22 F)) + (text . "\newline ") + (bcStrings (6 "0" u13 F)) + (bcStrings (6 "0" u23 F)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter {\it V(n,2)}. ") + (text . "If U(i,j) is known V(i,j) = 0.0, else V(i,j) = 1.0: \newline") + (bcStrings (6 "0.0" v11 F)) + (bcStrings (6 "1.0" v21 F)) + (text . "\newline ") + (bcStrings (6 "0.0" v12 F)) + (bcStrings (6 "0.0" v22 F)) + (text . "\newline ") + (bcStrings (6 "1.0" v13 F)) + (bcStrings (6 "1.0" v23 F)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Enter the initial mesh {\it X(mnp)}: ") + (text . "\newline ") + (bcStrings (8 "0.0" x1 F)) + (bcStrings (8 "0.4" x2 F)) + (bcStrings (8 "0.8" x3 F)) + (bcStrings (8 "1.2" x4 F)) + (bcStrings (8 "1.6" x5 F)) + (bcStrings (8 "2.0" x6 F)) + (bcStrings (8 "2.4" x7 F)) + (bcStrings (8 "2.8" x8 F)) + (bcStrings (8 "3.2" x9 F)) + (bcStrings (8 "3.6" x10 F)) + (bcStrings (8 "4.0" x11 F)) + (bcStrings (8 "4.4" x12 F)) + (bcStrings (8 "4.8" x13 F)) + (bcStrings (8 "5.2" x14 F)) + (bcStrings (8 "5.6" x15 F)) + (bcStrings (8 "6.0" x16 F)) + (bcStrings (8 "6.4" x17 F)) + (bcStrings (8 "6.8" x18 F)) + (bcStrings (8 "7.2" x19 F)) + (bcStrings (8 "7.6" x20 F)) + (bcStrings (8 "8.0" x21 F)) + (bcStrings (8 "8.4" x22 F)) + (bcStrings (8 "8.8" x23 F)) + (bcStrings (8 "9.2" x24 F)) + (bcStrings (8 "9.6" x25 F)) + (bcStrings (8 "10.0" x26 F)) + (bcStrings (8 "0.0" x27 F)) + (bcStrings (8 "0.0" x28 F)) + (bcStrings (8 "0.0" x29 F)) + (bcStrings (8 "0.0" x30 F)) + (bcStrings (8 "0.0" x31 F)) + (bcStrings (8 "0.0" x32 F)) + (bcStrings (8 "0.0" x33 F)) + (bcStrings (8 "0.0" x34 F)) + (bcStrings (8 "0.0" x35 F)) + (bcStrings (8 "0.0" x36 F)) + (bcStrings (8 "0.0" x37 F)) + (bcStrings (8 "0.0" x38 F)) + (bcStrings (8 "0.0" x39 F)) + (bcStrings (8 "0.0" x40 F)) + (bcStrings (8 "0.0" x41 F)) + (bcStrings (8 "0.0" x42 F)) + (bcStrings (8 "0.0" x43 F)) + (bcStrings (8 "0.0" x44 F)) + (bcStrings (8 "0.0" x45 F)) + (bcStrings (8 "0.0" x46 F)) + (bcStrings (8 "0.0" x47 F)) + (bcStrings (8 "0.0" x48 F)) + (bcStrings (8 "0.0" x49 F)) + (bcStrings (8 "0.0" x50 F)) + (bcStrings (8 "0.0" x51 F)) + (bcStrings (8 "0.0" x52 F)) + (bcStrings (8 "0.0" x53 F)) + (bcStrings (8 "0.0" x54 F)) + (bcStrings (8 "0.0" x55 F)) + (bcStrings (8 "0.0" x56 F)) + (bcStrings (8 "0.0" x57 F)) + (bcStrings (8 "0.0" x58 F)) + (bcStrings (8 "0.0" x59 F)) + (bcStrings (8 "0.0" x60 F)) + (bcStrings (8 "0.0" x61 F)) + (bcStrings (8 "0.0" x62 F)) + (bcStrings (8 "0.0" x63 F)) + (bcStrings (8 "0.0" x64 F))) + htpSetProperty(page,'n,n) + htpSetProperty(page,'a,a) + htpSetProperty(page,'b,b) + htpSetProperty(page,'mnp,mnp) + htpSetProperty(page,'np,np) + htpSetProperty(page,'lw,lw) + htpSetProperty(page,'liw,liw) + htpSetProperty(page,'tol,tol) + htpSetProperty(page,'ifail,ifail) + htMakeDoneButton('"Continue",'d02gafGen) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +d02gafGen htPage == + n := htpProperty(htPage, 'n) + a := htpProperty(htPage, 'a) + b := htpProperty(htPage, 'b) + mnp := htpProperty(htPage, 'mnp) + np := htpProperty(htPage, 'np) + lw := htpProperty(htPage, 'lw) + liw := htpProperty(htPage, 'liw) + ifail := htpProperty(htPage,'ifail) + tol := htpProperty(htPage,'tol) + alist := htpInputAreaAlist htPage + y := alist + for i in 1..mnp repeat + x := STRCONC((first y).1," ") + xList := [x,:xList] + y := rest y + xstring := bcwords2liststring xList + for i in 1..n repeat + for j in 1..2 repeat + v := STRCONC((first y).1," ") + rowList := [v,:rowList] + y := rest y + vList := [:vList,rowList] + rowList := [] + for i in 1..n repeat + for j in 1..2 repeat + u := STRCONC((first y).1," ") + rowList := [u,:rowList] + y := rest y + uList := [:uList,rowList] + rowList := [] + vList := reverse vList + uList := reverse uList + vstring := bcwords2liststring [bcwords2liststring x for x in vList] + ustring := bcwords2liststring [bcwords2liststring x for x in uList] + while y repeat + f := STRCONC((first y).1," ") + fList := [f,:fList] + y := rest y + fstring := bcwords2liststring fList + Y:='Y + prefix := STRCONC("d02gaf(",ustring,", ",vstring,", ",STRINGIMAGE n,", ") + prefix := STRCONC(prefix,a,", ",b,", ",tol,", ") + prefix := STRCONC(prefix,STRINGIMAGE mnp,", ",STRINGIMAGE lw,", ") + prefix := STRCONC(prefix,STRINGIMAGE liw,", [",xstring,"], ",STRINGIMAGE np) + end:=STRCONC (",",STRINGIMAGE ifail,",(",fstring,"::Vector Expression Float") + linkGen STRCONC (prefix,end,")::ASP7('FCN))") + +d02gbf() == + htInitPage('"D02GBF - ODEs, boundary value problem, finite difference technique with deferred correction, general nonlinear problem", nil) + htMakePage '( + (domainConditions + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXd02gbf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d02gbf| '|NagOrdinaryDifferentialEquationsPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\newline ") + (text . "D02GBF solves a general linear two-point boundary value problem ") + (text . "for a system of n ODEs {\it y' = F(x)y + g(x)} on the range ") + (text . "[a,b] with boundary conditions {\it Cy(a) + Dy(b) = \gamma} ") + (text . "using a deferred correction technique.") + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the number of equations in the system {\it n}:") + (text . "\newline\tab{2} ") + (bcStrings (5 2 n PI)) + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} ") + (text . "\newline Left hand boundary point {\it a}: ") + (text . "\tab{32} \menuitemstyle{}\tab{34} ") + (text . "Right hand boundary {\it b}:") + (text . "\newline\tab{2} ") + (bcStrings (10 "0.0" a F)) + (text . "\tab{34} ") + (bcStrings (10 "1.0" b F)) + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} ") + (text . "\newline Max number of mesh points {\it mnp}:") + (text . "\tab{32} \menuitemstyle{}\tab{34} ") + (text . "Number of points {\it np}: ") + (text . "\newline\tab{2} ") + (bcStrings (10 70 mnp PI)) + (text . "\tab{34} ") + (bcStrings (10 0 np PI)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Accuracy required {\it tol}:") + (text . "\newline\tab{2} ") + (bcStrings (10 "1.0e-3" tol F)) + (text . "\blankline ") + (text . "\newline \tab{2} ") + (text . "Ifail is input in three components: ") + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "{\it a} ") + (radioButtons afail + ("" " 0, hard failure" azero) + ("" " 1, soft failure" aone)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "{\it b} ") + (radioButtons bfail + ("" " 1, print error messages" bone) + ("" " 0, suppress error messages" bzero)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "{\it c} ") + (radioButtons cfail + ("" " 1, print warning messages" cone) + ("" " 0, suppress warning messages" czero))) + htMakeDoneButton('"Continue", 'd02gbfSolve) + htShowPage() + +d02gbfSolve htPage == + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + a := htpLabelInputString(htPage,'a) + b := htpLabelInputString(htPage,'b) + mnp := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'mnp) + objValUnwrap htpLabelSpadValue(htPage, 'mnp) + np := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'np) + objValUnwrap htpLabelSpadValue(htPage, 'np) + lw := mnp * (3*n*n + 5*n + 2) + 3*n*n + 5*n + liw := mnp * (2*n + 1) + n + tol := htpLabelInputString(htPage,'tol) + aerror := htpButtonValue(htPage,'afail) + afail := + aerror = 'azero => '0 + '1 + berror := htpButtonValue(htPage,'bfail) + bfail := + berror = 'bone => '1 + '0 + cerror := htpButtonValue(htPage,'cfail) + cfail := + cerror = 'cone => '1 + '0 + ifail := 100*cfail + 10*bfail + afail + n = '2 => d02gbfDefaultSolve(htPage,a,b,mnp,np,lw,liw,tol,ifail) + cList := + "append"/[fa(i,n) for i in 1..n] where fa(i,n) == + labelList := + "append"/[fb(i,j) for j in 1..n] where fb(i,j) == + cnam := INTERN STRCONC ('"c",STRINGIMAGE i,STRINGIMAGE j) + [['bcStrings,[6, 0, cnam, 'F]]] + prefix := ('"\newline ") + labelList := [['text,:prefix],:labelList] + middle := ('"\blankline \menuitemstyle{} \tab{2} Enter the matrix {\it D}: ") + middle := STRCONC(middle,"\newline ") + dList := + "append"/[fc(i,n) for i in 1..n] where fc(i,n) == + labelList := + "append"/[fd(i,j) for j in 1..n] where fd(i,j) == + dnam := INTERN STRCONC ('"d",STRINGIMAGE i,STRINGIMAGE j) + [['bcStrings,[6, 0, dnam, 'F]]] + prefix := ('"\newline ") + labelList := [['text,:prefix],:labelList] + dList := [['text,:middle],:dList] + middle := ('"\blankline \menuitemstyle{} \tab{2} Enter the vector \gamma: ") + middle := STRCONC(middle,"\newline ") + gamList := + "append"/[fe(i) for i in 1..n] where fe(i) == + gamnam := INTERN STRCONC ('"gam",STRINGIMAGE i) + [['bcStrings,[6, 0, gamnam, 'F]]] + prefix := ('"\newline ") + gamList := [['text,:middle],:gamList] + middle := ('"\blankline \menuitemstyle{} \tab{2} Enter the matrix ") + middle := STRCONC(middle,"{\it F(x)} from the equation {\it y' =} ") + middle := STRCONC(middle,"{\it F(x)y + g(x)}: \newline ") + fList := + "append"/[ff(i,n) for i in 1..n] where ff(i,n) == + labelList := + "append"/[fg(i,j) for j in 1..n] where fg(i,j) == + fnam := INTERN STRCONC ('"f",STRINGIMAGE i,STRINGIMAGE j) + [['bcStrings,[6, 0, fnam, 'F]]] + prefix := ('"\newline ") + labelList := [['text,:prefix],:labelList] + fList := [['text,:middle],:fList] + mid := ('"\blankline \menuitemstyle{} \tab{2} Enter the vector {\it g(x)}: ") + mid := STRCONC(mid,'"\newline ") + gList := + "append"/[fh(i) for i in 1..n] where fh(i) == + gnam := INTERN STRCONC ('"g",STRINGIMAGE i) + [['bcStrings,[6, 0, gnam, 'F]]] + prefix := ('"\newline ") + gList := [['text,:middle],:gList] + xList := + "append"/[fi(i) for i in 1..mnp] where fi(i) == + xnam := INTERN STRCONC ('"x",STRINGIMAGE i) + [['bcStrings,[8, "0.0", xnam, 'F]]] + end := ('"\blankline \menuitemstyle{} \tab{2} The initial mesh {\it X(mnp)}") + end := STRCONC(end,'", (all entries = 0 if np < 4): \newline ") + xList := [['text,:end],:xList] + equationPart := [ + '(domainConditions + (isDomain EM $EmptyMode) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain I (Integer))), + :cList,:dList,:gamList,:fList,:gList,:xList] + page := htInitPage('"D02GBF - ODEs, boundary value problem, finite difference technique with deferred correction, general nonlinear problem", nil) + htSay '"\menuitemstyle{}\tab{2} " + htSay '"Enter the matrix {\it C} form the equation {\it Cy(a) + Dy(b)} " + htSay '"= \gamma \newline " + htMakePage equationPart + htMakeDoneButton('"Continue",'d02gbfGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'a,a) + htpSetProperty(page,'b,b) + htpSetProperty(page,'mnp,mnp) + htpSetProperty(page,'np,np) + htpSetProperty(page,'lw,lw) + htpSetProperty(page,'liw,liw) + htpSetProperty(page,'tol,tol) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +d02gbfDefaultSolve(htPage,a,b,mnp,np,lw,liw,tol,ifail) == + n := '2 + page := htInitPage('"D02GBF - ODEs, boundary value problem, finite difference technique with deferred correction, general nonlinear problem", nil) + htMakePage '( + (domainConditions + (isDomain EM $EmptyMode) + (isDomain F (Float)) + (isDomain I (Integer))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the matrix {\it C} from the equation {\it Cy(a) + Dy(b)} = \gamma:") + (text . "\newline ") + (bcStrings (6 "1" c11 F)) + (bcStrings (6 "0" c12 F)) + (text . "\newline ") + (bcStrings (6 "0" c21 F)) + (bcStrings (6 "0" c22 F)) + (text . "\blankline \menuitemstyle{}\tab{2}") + (text . "Enter the matrix {\it D}: \newline ") + (bcStrings (6 "0" d11 F)) + (bcStrings (6 "0" d12 F)) + (text . "\newline ") + (bcStrings (6 "1" d21 F)) + (bcStrings (6 "0" d22 F)) + (text . "\blankline \menuitemstyle{}\tab{2}") + (text . "Enter the vector \gamma: \newline ") + (bcStrings (6 "0" gam1 F)) + (bcStrings (6 "1" gam2 F)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the matrix {\it F(x)} from the equation {\it y' = F(x)y + g(x)} : ") + (text . "\newline ") + (bcStrings (6 "0" f11 F)) + (bcStrings (6 "1" f12 F)) + (text . "\newline ") + (bcStrings (6 "0" f21 F)) + (bcStrings (6 "-10" f22 F)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the vector {\it g(x)}: ") + (text . "\newline ") + (bcStrings (6 "0" g1 F)) + (bcStrings (6 "0" g2 F)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2} The initial mesh {\it X(mnp)}, ") + (text . "(all entries = 0 if np < 4): \newline ") + (bcStrings (8 "0.0" x1 F)) + (bcStrings (8 "0.0" x2 F)) + (bcStrings (8 "0.0" x3 F)) + (bcStrings (8 "0.0" x4 F)) + (bcStrings (8 "0.0" x5 F)) + (bcStrings (8 "0.0" x6 F)) + (bcStrings (8 "0.0" x7 F)) + (bcStrings (8 "0.0" x8 F)) + (bcStrings (8 "0.0" x9 F)) + (bcStrings (8 "0.0" x10 F)) + (bcStrings (8 "0.0" x11 F)) + (bcStrings (8 "0.0" x12 F)) + (bcStrings (8 "0.0" x13 F)) + (bcStrings (8 "0.0" x14 F)) + (bcStrings (8 "0.0" x15 F)) + (bcStrings (8 "0.0" x16 F)) + (bcStrings (8 "0.0" x17 F)) + (bcStrings (8 "0.0" x18 F)) + (bcStrings (8 "0.0" x19 F)) + (bcStrings (8 "0.0" x20 F)) + (bcStrings (8 "0.0" x21 F)) + (bcStrings (8 "0.0" x22 F)) + (bcStrings (8 "0.0" x23 F)) + (bcStrings (8 "0.0" x24 F)) + (bcStrings (8 "0.0" x25 F)) + (bcStrings (8 "0.0" x26 F)) + (bcStrings (8 "0.0" x27 F)) + (bcStrings (8 "0.0" x28 F)) + (bcStrings (8 "0.0" x29 F)) + (bcStrings (8 "0.0" x30 F)) + (bcStrings (8 "0.0" x31 F)) + (bcStrings (8 "0.0" x32 F)) + (bcStrings (8 "0.0" x33 F)) + (bcStrings (8 "0.0" x34 F)) + (bcStrings (8 "0.0" x35 F)) + (bcStrings (8 "0.0" x36 F)) + (bcStrings (8 "0.0" x37 F)) + (bcStrings (8 "0.0" x38 F)) + (bcStrings (8 "0.0" x39 F)) + (bcStrings (8 "0.0" x40 F)) + (bcStrings (8 "0.0" x41 F)) + (bcStrings (8 "0.0" x42 F)) + (bcStrings (8 "0.0" x43 F)) + (bcStrings (8 "0.0" x44 F)) + (bcStrings (8 "0.0" x45 F)) + (bcStrings (8 "0.0" x46 F)) + (bcStrings (8 "0.0" x47 F)) + (bcStrings (8 "0.0" x48 F)) + (bcStrings (8 "0.0" x49 F)) + (bcStrings (8 "0.0" x50 F)) + (bcStrings (8 "0.0" x51 F)) + (bcStrings (8 "0.0" x52 F)) + (bcStrings (8 "0.0" x53 F)) + (bcStrings (8 "0.0" x54 F)) + (bcStrings (8 "0.0" x55 F)) + (bcStrings (8 "0.0" x56 F)) + (bcStrings (8 "0.0" x57 F)) + (bcStrings (8 "0.0" x58 F)) + (bcStrings (8 "0.0" x59 F)) + (bcStrings (8 "0.0" x60 F)) + (bcStrings (8 "0.0" x61 F)) + (bcStrings (8 "0.0" x62 F)) + (bcStrings (8 "0.0" x63 F)) + (bcStrings (8 "0.0" x64 F)) + (bcStrings (8 "0.0" x65 F)) + (bcStrings (8 "0.0" x66 F)) + (bcStrings (8 "0.0" x67 F)) + (bcStrings (8 "0.0" x68 F)) + (bcStrings (8 "0.0" x69 F)) + (bcStrings (8 "0.0" x70 F))) + htpSetProperty(page,'n,n) + htpSetProperty(page,'a,a) + htpSetProperty(page,'b,b) + htpSetProperty(page,'mnp,mnp) + htpSetProperty(page,'np,np) + htpSetProperty(page,'lw,lw) + htpSetProperty(page,'liw,liw) + htpSetProperty(page,'tol,tol) + htpSetProperty(page,'ifail,ifail) + htMakeDoneButton('"Continue",'d02gbfGen) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +d02gbfGen htPage == + n := htpProperty(htPage, 'n) + a := htpProperty(htPage, 'a) + b := htpProperty(htPage, 'b) + mnp := htpProperty(htPage, 'mnp) + np := htpProperty(htPage, 'np) + lw := htpProperty(htPage, 'lw) + liw := htpProperty(htPage, 'liw) + ifail := htpProperty(htPage,'ifail) + tol := htpProperty(htPage,'tol) + alist := htpInputAreaAlist htPage + y := alist + for i in 1..mnp repeat -- matrix + x := STRCONC((first y).1," ") + xList := [x,:xList] + y := rest y + xstring := bcwords2liststring xList + for i in 1..n repeat -- vector g + g := STRCONC((first y).1," ") + gList := [g,:gList] + y := rest y + gstring := bcwords2liststring gList + for i in 1..n repeat -- matrix F + for j in 1..n repeat + f := STRCONC((first y).1," ") + flist := [f,:flist] + y := rest y + fmatlist := [:fmatlist,flist] + flist := [] + fmatlist := reverse fmatlist + fmatstr := bcwords2liststring [bcwords2liststring x for x in fmatlist] + for i in 1..n repeat -- vector gamma + gam := STRCONC((first y).1," ") + gamList := [gam,:gamList] + y := rest y + gamstr := bcwords2liststring gamList + for i in 1..n repeat -- matrix D + for j in 1..n repeat + d := STRCONC((first y).1," ") + dlist := [d,:dlist] + y := rest y + dmatlist := [:dmatlist,dlist] + dlist := [] + dmatlist := reverse dmatlist + dmatstr := bcwords2liststring [bcwords2liststring x for x in dmatlist] + for i in 1..n repeat -- matrix C + for j in 1..n repeat + c := STRCONC((first y).1," ") + clist := [c,:clist] + y := rest y + cmatlist := [:cmatlist,clist] + clist := [] + cmatlist := reverse cmatlist + cmatstr := bcwords2liststring [bcwords2liststring x for x in cmatlist] + prefix := STRCONC("d02gbf(",STRINGIMAGE a,", ",STRINGIMAGE b,", ") + prefix := STRCONC(prefix,STRINGIMAGE n,", ",tol,", ",STRINGIMAGE mnp,", ") + prefix := STRCONC(prefix,STRINGIMAGE lw,", ",STRINGIMAGE liw,", ") + prefix := STRCONC(prefix,cmatstr,"::Matrix DoubleFloat,",dmatstr,"::Matrix DoubleFloat,[",gamstr,"]::Matrix DoubleFloat,[",xstring,"]::Matrix DoubleFloat, ") + mid := STRCONC(STRINGIMAGE np,", ",STRINGIMAGE ifail,", ") + end := STRCONC("(",fmatstr,"::Matrix(Expression(Float)))::ASP77(FCNF),(",gstring) + linkGen STRCONC(prefix,mid,end,"::Vector(Expression(Float)))::ASP78(FCNG))") + +d02kef() == + htInitPage('"D02KEF - 2nd order Sturm-Liouville problem, regular/singular system, finite/infinite range, eigenvalue and eigenfunction, user-specified break-points", nil) + htMakePage '( + (domainConditions + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXd02kef} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d02kef| '|NagOrdinaryDifferentialEquationsPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\newline ") + (text . "D02KEF finds a specified eigenvalue \htbitmap{lamdab} of a ") + (text . "regular or second-order Sturm-Liouville system ") + (text . "{\it(p(x)y')' + q(x; \lambda)y = 0} on a finite or infinite ") + (text . "range [a,b]; a Pruefer transformation and shooting method ") + (text . "are used; discontinuities in coefficient functions or their ") + (text . "derivatives are permitted. ") + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Number of points in XPOINT {\it m}:") + (text . "\newline\tab{2} ") + (bcStrings (6 5 m PI)) + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} ") + (text . "\newline Index of the `break-point' {\it match}:") + (text . "\newline\tab{2} ") + (bcStrings (6 0 match PI)) + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} ") + (text . "\newline Index of the required eigenvalue {\it k}:") + (text . "\newline\tab{2} ") + (bcStrings (6 11 k PI)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Accuracy required {\it tol}:") + (text . "\newline\tab{2} ") + (bcStrings (10 "0.0001" tol F)) + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} \newline ") + (text . "Eigenvalue estimate {\it elam}: ") + (text . "\tab{32} \menuitemstyle{}\tab{34} ") + (text . "Scale of the problem {\it delam}: ") + (text . "\newline\tab{2} ") + (bcStrings (10 "14" elam F)) + (text . "\tab{34} ") + (bcStrings (10 "1" delam F)) + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} \newline ") + (text . "Max iterations {\it maxit}:") + (text . "\tab{32} \menuitemstyle{}\tab{34} ") + (text . "Max COEFFN calls {\it maxfun}:") + (text . "\newline\tab{2} ") + (bcStrings (10 0 maxit PI)) + (text . "\tab{34} ") + (bcStrings (10 0 maxfun PI)) + (text . "\blankline ") + (text . "\tab{2} \newline {\it Note:} no bound is assumed ") + (text . "if maxit = 0 \blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Ifail value:") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'd02kefSolve) + htShowPage() + +d02kefSolve htPage == + m := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) + objValUnwrap htpLabelSpadValue(htPage, 'm) + match := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'match) + objValUnwrap htpLabelSpadValue(htPage, 'match) + k := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'k) + objValUnwrap htpLabelSpadValue(htPage, 'k) + tol := htpLabelInputString(htPage,'tol) + elam := htpLabelInputString(htPage,'elam) + delam := htpLabelInputString(htPage,'delam) + maxit := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'maxit) + objValUnwrap htpLabelSpadValue(htPage, 'maxit) + maxfun := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'maxfun) + objValUnwrap htpLabelSpadValue(htPage, 'maxfun) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'minusOne => '-1 + '1 + m = '5 =>d02kefDefaultSolve(htPage,match,k,tol,elam,delam,maxit,maxfun,ifail) + xpList := + "append"/[fa(i) for i in 1..m] where fa(i) == + xpnam := INTERN STRCONC ('"xp",STRINGIMAGE i) + [['bcStrings,[10, "0.0", xpnam, 'EM]]] + middle:=('"\blankline \menuitemstyle{} \tab{2} Value of {\it p} for COEFFN:") + middle := STRCONC(middle,"\newline ") + cList := [['text,:middle],['bcStrings,[42, "0.0", 'c1, 'EM]]] + middle:=('"\blankline \menuitemstyle{} \tab{2} Value of {\it q} for COEFFN:") + middle := STRCONC(middle,"\newline ") + c1List := [['text,:middle],['bcStrings,[42, "0.0", 'c2, 'EM]]] + cList := [:cList,:c1List] + middle:=('"\blankline \menuitemstyle{} \tab{2} Value of {\it dqdl}") + middle := STRCONC(middle," for COEFFN: \newline ") + c2List := [['text,:middle],['bcStrings,[42, "0.0", 'c3, 'EM]]] + cList := [:cList,:c2List] + middle:=('"\blankline \menuitemstyle{} \tab{2} Values of YL(1) & YL(2) ") + middle := STRCONC(middle,"for BDYVAL: \newline ") + ylList := + "append"/[fb(i) for i in 1..2] where fb(i) == + ylnam := INTERN STRCONC ('"yl",STRINGIMAGE i) + [['bcStrings,[42, "0.0", ylnam, 'EM]]] + ylList := [['text,:middle],:ylList] + middle:=('"\blankline \menuitemstyle{} \tab{2} Values of YR(1) & YR(2) ") + middle := STRCONC(middle,"for BDYVAL: \newline ") + yrList := + "append"/[fc(i) for i in 1..2] where fc(i) == + yrnam := INTERN STRCONC ('"yr",STRINGIMAGE i) + [['bcStrings,[42, "0.0", yrnam, 'EM]]] + yrList := [['text,:middle],:yrList] + middle:=('"\blankline \menuitemstyle{} \tab{2} Maximum step size ") + middle := STRCONC(middle,"{\it hmax(2,m)}: \newline ") + hList := + "append"/[fd(i,m) for i in 1..2] where fd(i,m) == + labelList := + "append"/[fe(i,j) for j in 1..m] where fe(i,j) == + hnam := INTERN STRCONC ('"h",STRINGIMAGE i,STRINGIMAGE j) + [['bcStrings,[6, "0.0", hnam, 'F]]] + prefix := ('"\newline ") + labelList := [['text,:prefix],:labelList] + hList := [['text,:middle],:hList] + equationPart := [ + '(domainConditions + (isDomain EM $EmptyMode) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain I (Integer))), + :xpList,:cList,:ylList,:yrList,:hList] + page := htInitPage('"D02KEF - 2nd order Sturm-Liouville problem, regular/singular system, finite/infinite range, eigenvalue and eigenfunction, user-specified break-points", nil) + htSay '"\menuitemstyle{}\tab{2} Enter points where boundary " + htSay '"conditions are to be imposed {\it xpoint}: \newline " + htMakePage equationPart + htMakeDoneButton('"Continue",'d02kefGen) + htpSetProperty(page,'m,m) + htpSetProperty(page,'match,match) + htpSetProperty(page,'k,k) + htpSetProperty(page,'tol,tol) + htpSetProperty(page,'elam,elam) + htpSetProperty(page,'delam,delam) + htpSetProperty(page,'maxit,maxit) + htpSetProperty(page,'maxfun,maxfun) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +d02kefDefaultSolve(htPage,match,k,tol,elam,delam,maxit,maxfun,ifail) == + m := '5 + page := htInitPage('"D02KEF - 2nd order Sturm-Liouville problem, regular/singular system, finite/infinite range, eigenvalue and eigenfunction, user-specified break-points", nil) + htMakePage '( + (domainConditions + (isDomain EM $EmptyMode) + (isDomain F (Float)) + (isDomain I (Integer))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter points where boundary conditions are to be imposed ") + (text . "{\it xpoint}: \newline ") + (bcStrings (10 "0.0" xp1 F)) + (bcStrings (10 "0.1" xp2 F)) + (bcStrings (10 "4**(1/3)" xp3 F)) + (bcStrings (10 "30.0" xp4 F)) + (bcStrings (10 "30.0" xp5 F)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Value of {\it p} for COEFFN: \newline ") + (bcStrings (42 "1.0" c1 EM)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Value of {\it q} for COEFFN: \newline ") + (bcStrings (42 "ELAM-X-2.0/(X*X)" c2 EM)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Value of {\it dqdl} for COEFFN: \newline ") + (bcStrings (42 "1.0" c3 EM)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Values of YL(1) & YL(2) for BDYVAL: \newline ") + (bcStrings (42 "XL" yl1 EM)) + (bcStrings (42 "2.0" yl2 EM)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Values of YR(1) & YR(2) for BDYVAL: \newline ") + (bcStrings (42 "1.0" yr1 EM)) + (bcStrings (42 "-sqrt(XR-ELAM)" yr2 EM)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Maximum step size {\it hmax(2,m)}: \newline ") + (bcStrings (6 "0.0" h11 F)) + (bcStrings (6 "0.0" h12 F)) + (bcStrings (6 "0.0" h13 F)) + (bcStrings (6 "0.0" h14 F)) + (bcStrings (6 "0.0" h15 F)) + (text . "\newline ") + (bcStrings (6 "0.0" h21 F)) + (bcStrings (6 "0.0" h22 F)) + (bcStrings (6 "0.0" h23 F)) + (bcStrings (6 "0.0" h24 F)) + (bcStrings (6 "0.0" h25 F))) + htpSetProperty(page,'m,m) + htpSetProperty(page,'match,match) + htpSetProperty(page,'k,k) + htpSetProperty(page,'tol,tol) + htpSetProperty(page,'elam,elam) + htpSetProperty(page,'delam,delam) + htpSetProperty(page,'maxit,maxit) + htpSetProperty(page,'maxfun,maxfun) + htpSetProperty(page,'ifail,ifail) + htMakeDoneButton('"Continue",'d02kefGen) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +d02kefGen htPage == + m := htpProperty(htPage, 'm) + match := htpProperty(htPage, 'match) + k := htpProperty(htPage, 'k) + tol := htpProperty(htPage, 'tol) + elam := htpProperty(htPage, 'elam) + delam := htpProperty(htPage, 'delam) + maxit := htpProperty(htPage, 'maxit) + maxfun := htpProperty(htPage, 'maxfun) + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + for i in 1..m repeat + for j in 1..2 repeat + h := STRCONC((first y).1," ") + rowList := [h,:rowList] + y := rest y + hList := [:hList,rowList] + rowList := [] + hList := reverse hList + hstring := bcwords2liststring [bcwords2liststring x for x in hList] + for i in 1..2 repeat + for j in 1..2 repeat + b := STRCONC((first y).1," ") + rowList := [b,:rowList] + y := rest y + bList := [:bList,rowList] + rowList := [] + bList := reverse bList + bstring := bcwords2liststring [bcwords2liststring x for x in bList] + for i in 1..3 repeat + c := STRCONC((first y).1," ") + cList := [c,:cList] + y := rest y + cstring := bcwords2liststring cList + while y repeat + x := STRCONC((first y).1," ") + xList := [x,:xList] + y := rest y + xstring := bcwords2liststring xList + prefix := STRCONC("d02kef([",xstring,"]::Matrix DoubleFloat, ",STRINGIMAGE m) + prefix := STRCONC(prefix,", ",STRINGIMAGE k,", ",tol,", ",STRINGIMAGE maxfun) + prefix := STRCONC(prefix,", ",STRINGIMAGE match,", ",STRINGIMAGE elam,", ") + prefix:=STRCONC(prefix,STRINGIMAGE delam,", ",hstring,", ",STRINGIMAGE maxit) + end := STRCONC(", ",STRINGIMAGE ifail,",(",cstring,"::Vector(Expression Float))::ASP10(COEFFN)") + end := STRCONC(end,", (",bstring,"::Matrix Expression Float)::ASP80('BDYVAL))") + linkGen STRCONC (prefix,end) + +d02raf() == + htInitPage('"D02RAF - ODEs, general nonlinear boundary value problem, finite difference technique with deferred correction, continuation facility",nil) + htMakePage '( + (domainConditions + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXd02raf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d02raf| '|NagOrdinaryDifferentialEquationsPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\newline ") + (text . "D02RAF solves a two-point boundary value problem for a system ") + (text . "of {\it n} first-order ordinary differential equations ") + (text . "{\it \htbitmap{yi}'= \htbitmap{fi}(x,y)}, for {\it i} = 1,2,...,") + (text . "{\it n}, on the range [a,b] with {\it n} nonlinear boundary ") + (text . "conditions \htbitmap{gi}{\it (y(a),y(b)) = 0} for {\it i} = 1,2,") + (text . "...,{\it n} using a deferred correction technique and a Newton ") + (text . "iteration; the solution is computed on a mesh. A continuation ") + (text . "facility is provided for which a family of problems is solved ") + (text . "posed as {\it y' = f(x,y,\epsilon)} subject to the boundary ") + (text . "conditions {\it g(y(a),y(b),\epsilon) = 0}, where \epsilon ") + (text . "is the continuation parameter. The choice \epsilon = 0 should ") + (text . "define an easy problem to solve and \epsilon = 1 the problem ") + (text . "whose solution is required; a sequence of problems is solved ") + (text . "with 0 = \htbitmap{ep1} < \htbitmap{ep2} < ... \htbitmap{epp} ") + (text . "= 1 where {\it p} and the \htbitmap{epi} are chosen by D02RAF. ") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the number of differential equations {\it n}: ") + (text . "\newline\tab{2} ") + (bcStrings (5 3 n PI)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "The maximum number of points in the mesh {\it mnp}: ") + (text . "\newline\tab{2} ") + (bcStrings (5 40 mnp PI)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Number of points in the initial mesh {\it np}:") + (text . "\newline\tab{2} ") + (bcStrings (5 17 np PI)) + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} ") + (text . "\newline Number of boundary conditions involving y(a) only ") + (text . "{\it numbeg}: \newline\tab{2} ") + (bcStrings (5 2 numbeg PI)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "\newline Boundary conditions involving both y(a) and ") + (text . "y(b) {\it nummix}: \newline\tab{2} ") + (text . "\newline\tab{2} ") + (bcStrings (5 0 nummix PI)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Absolute error tolerance {\it tol}: ") + (text . "\newline\tab{2} ") + (bcStrings (10 "1.0e-4" tol F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Do you wish to use an intial mesh or default values,{\it init} ") + (radioButtons init + ("" " default values" init_zero) + ("" " initial mesh" init_nonZero)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "First dimension of y, {\it iy}: ") + (text . "\newline\tab{2} ") + (bcStrings (5 3 iy PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Are JACOBF & JACOBG routines being supplied, {\it ijac}:") + (radioButtons ijac + ("" " yes" ijac_nonZero) + ("" " no" ijac_zero)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Continuation facility {\it deleps}:") + (text . "\newline\tab{2} ") + (bcStrings (5 "0.1" deleps F)) + (text . "\newline\tab{2} ") + (text . "Note: For 0.0 \htbitmap{great=} deleps > 1.0, continuation ") + (text . "is not used. ") + (text . "\blankline ") + (text . "\newline \tab{2} ") + (text . "Ifail is input in three components: ") + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "{\it a} ") + (radioButtons afail + ("" " 0, hard failure" azero) + ("" " 1, soft failure" aone)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "{\it b} ") + (radioButtons bfail + ("" " 1, print error messages" bone) + ("" " 0, suppress error messages" bzero)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "{\it c} ") + (radioButtons cfail + ("" " 1, print warning messages" cone) + ("" " 0, suppress warning messages" czero))) + htMakeDoneButton('"Continue", 'd02rafSolve) + htShowPage() + +d02rafSolve htPage == + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + mnp := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'mnp) + objValUnwrap htpLabelSpadValue(htPage, 'mnp) + np := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'np) + objValUnwrap htpLabelSpadValue(htPage, 'np) + numbeg := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'numbeg) + objValUnwrap htpLabelSpadValue(htPage, 'numbeg) + nummix := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nummix) + objValUnwrap htpLabelSpadValue(htPage, 'nummix) + tol := htpLabelInputString(htPage,'tol) + mesh := htpButtonValue(htPage,'init) + init := + mesh = 'init_zero => '0 + '1 + iy := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iy) + objValUnwrap htpLabelSpadValue(htPage, 'iy) + jacob := htpButtonValue(htPage,'ijac) + ijac := + jacob = 'ijac_zero => '0 + '1 + deleps := htpLabelInputString(htPage,'deleps) + lwork := mnp*(3*n*n + 6*n +2) +4*n*n + 3*n + liwork := + ijac = 0 => mnp*(2*n +1) + n*n + 4*n +2 + mnp*(2*n +1) + n + aerror := htpButtonValue(htPage,'afail) + afail := + aerror = 'azero => '0 + '1 + berror := htpButtonValue(htPage,'bfail) + bfail := + berror = 'bone => '1 + '0 + cerror := htpButtonValue(htPage,'cfail) + cfail := + cerror = 'cone => '1 + '0 + ifail := 100*cfail + 10*bfail + afail + (n = '3 and init = '0 and iy = '3 and nummix = '0 and numbeg = '2 and np = '17 and mnp = '40) => d02rafDefaultSolve(htPage,mnp,np,numbeg,nummix,tol,init,iy,ijac,deleps,lwork,liwork,ifail) + init = '1 => d02rafCopOut() + funcList := + "append"/[fa(i) for i in 1..n] where fa(i) == + prefix := ('"\newline {\em Function f") + prefix := STRCONC(prefix,STRINGIMAGE i,'":} \space{1}") + funct := STRCONC ('"Y[",STRINGIMAGE i ,"]") + fnam := INTERN STRCONC ('"f",STRINGIMAGE i) + [['text,:prefix],['bcStrings,[42, funct, fnam, 'EM]]] + middle := ('"\blankline \menuitemstyle{} \tab{2} Enter the functions ") + middle := STRCONC(middle,'"\htbitmap{gi} below ") + middle := STRCONC(middle,'"as functions of YA[i] and YB[i]: \newline ") + gList := + "append"/[fb(i) for i in 1..n] where fb(i) == + prefix := ('"\newline {\em Function g") + prefix := STRCONC(prefix,STRINGIMAGE i,'":} \space{1}") + fnc := STRCONC ('"YA[",STRINGIMAGE i ,"]") + gnam := INTERN STRCONC ('"g",STRINGIMAGE i) + [['text,:prefix],['bcStrings,[42, fnc, gnam, 'EM]]] + gList := [['text,:middle],:gList] + mid:= ('"\blankline \menuitemstyle{} \tab{2} Enter the array ") + mid := STRCONC(mid,'"{\it x(mnp)}: \newline ") + xList := + "append"/[fc(i) for i in 1..mnp] where fc(i) == + xnam := INTERN STRCONC ('"x",STRINGIMAGE i) + [['bcStrings,[4, 0, xnam, 'F]]] + xList := [['text,:mid],:xList] + equationPart := [ + '(domainConditions + (isDomain EM $EmptyMode) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain I (Integer))), + :funcList,:gList,:xList] + page := htInitPage('"D02RAF - ODEs, general nonlinear boundary value problem, finite difference technique with deferred correction, continuation facility",nil) + htSay '"\menuitemstyle{}\tab{2} " + htSay '"Enter the functions \htbitmap{fi} (i.e. the derivatives) below " + htSay '"as functions of Y[1]...Y[n]: " + htSay '"\newline " + htMakePage equationPart + htMakeDoneButton('"Continue",'d02rafGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'mnp,mnp) + htpSetProperty(page,'np,np) + htpSetProperty(page,'numbeg,numbeg) + htpSetProperty(page,'nummix,nummix) + htpSetProperty(page,'tol,tol) + htpSetProperty(page,'init,init) + htpSetProperty(page,'iy,iy) + htpSetProperty(page,'ijac,ijac) + htpSetProperty(page,'deleps,deleps) + htpSetProperty(page,'lwork,lwork) + htpSetProperty(page,'liwork,liwork) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +d02rafDefaultSolve(htPage,mnp,np,numbeg,nummix,tol,init,iy,ijac,deleps,lwork,liwork,ifail) == + n := '3 + page := htInitPage('"D02RAF - ODEs, general nonlinear boundary value problem, finite difference technique with deferred correction, continuation facility",nil) + htMakePage '( + (domainConditions + (isDomain EM $EmptyMode) + (isDomain F (Float)) + (isDomain I (Integer))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the functions \htbitmap{fi} (i.e. the derivatives) below ") + (text . "as functions of Y[1]...Y[n]: ") + (text . "\newline {\em Function f1:} \space{1}") + (bcStrings (44 "Y[2]" f1 EM)) + (text . "\newline {\em Function f2:} \space{1}") + (bcStrings (44 "Y[3]" f2 EM)) + (text . "\newline {\em Function f3:} \space{1}") + (bcStrings (44 "-Y[1]*Y[3] - 2*EPS*(1-Y[2]*Y[2])" f3 EM)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the functions \htbitmap{gi} below ") + (text . "as functions of YA[i] and YB[i]: ") + (text . "\newline {\em Function g1:} \space{1}") + (bcStrings (44 "YA[1]" g1 EM)) + (text . "\newline {\em Function g2:} \space{1}") + (bcStrings (44 "YA[2]" g2 EM)) + (text . "\newline {\em Function g3:} \space{1}") + (bcStrings (44 "YB[2] -1" g3 EM)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the array {\it x(mnp)}: \newline ") + (bcStrings (4 "0.0" x1 F)) + (bcStrings (4 "0.0" x2 F)) + (bcStrings (4 "0.0" x3 F)) + (bcStrings (4 "0.0" x4 F)) + (bcStrings (4 "0.0" x5 F)) + (bcStrings (4 "0.0" x6 F)) + (bcStrings (4 "0.0" x7 F)) + (bcStrings (4 "0.0" x8 F)) + (bcStrings (4 "0.0" x9 F)) + (bcStrings (4 "0.0" x10 F)) + (bcStrings (4 "0.0" x11 F)) + (bcStrings (4 "0.0" x12 F)) + (bcStrings (4 "0.0" x13 F)) + (bcStrings (4 "0.0" x14 F)) + (bcStrings (4 "0.0" x15 F)) + (bcStrings (4 "0.0" x16 F)) + (bcStrings (4 "10.0" x17 F)) + (bcStrings (4 "0.0" x18 F)) + (bcStrings (4 "0.0" x19 F)) + (bcStrings (4 "0.0" x20 F)) + (bcStrings (4 "0.0" x21 F)) + (bcStrings (4 "0.0" x22 F)) + (bcStrings (4 "0.0" x23 F)) + (bcStrings (4 "0.0" x24 F)) + (bcStrings (4 "0.0" x25 F)) + (bcStrings (4 "0.0" x26 F)) + (bcStrings (4 "0.0" x27 F)) + (bcStrings (4 "0.0" x28 F)) + (bcStrings (4 "0.0" x29 F)) + (bcStrings (4 "0.0" x30 F)) + (bcStrings (4 "0.0" x31 F)) + (bcStrings (4 "0.0" x32 F)) + (bcStrings (4 "0.0" x33 F)) + (bcStrings (4 "0.0" x34 F)) + (bcStrings (4 "0.0" x35 F)) + (bcStrings (4 "0.0" x36 F)) + (bcStrings (4 "0.0" x37 F)) + (bcStrings (4 "0.0" x38 F)) + (bcStrings (4 "0.0" x39 F)) + (bcStrings (4 "0.0" x40 F))) + htpSetProperty(page,'n,n) + htpSetProperty(page,'mnp,mnp) + htpSetProperty(page,'np,np) + htpSetProperty(page,'numbeg,numbeg) + htpSetProperty(page,'nummix,nummix) + htpSetProperty(page,'tol,tol) + htpSetProperty(page,'init,init) + htpSetProperty(page,'iy,iy) + htpSetProperty(page,'ijac,ijac) + htpSetProperty(page,'deleps,deleps) + htpSetProperty(page,'lwork,lwork) + htpSetProperty(page,'liwork,liwork) + htpSetProperty(page,'ifail,ifail) + htMakeDoneButton('"Continue",'d02rafGen) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +d02rafGen htPage == + n := htpProperty(htPage, 'n) + mnp := htpProperty(htPage, 'mnp) + np := htpProperty(htPage, 'np) + numbeg := htpProperty(htPage, 'numbeg) + nummix := htpProperty(htPage, 'nummix) + tol := htpProperty(htPage, 'tol) + init := htpProperty(htPage, 'init) + iy := htpProperty(htPage, 'iy) + ijac := htpProperty(htPage, 'ijac) + deleps := htpProperty(htPage, 'deleps) + lwork := htpProperty(htPage, 'lwork) + liwork := htpProperty(htPage, 'liwork) + ifail := htpProperty(htPage, 'ifail) + alist := htpInputAreaAlist htPage + y := alist + for i in 1..mnp repeat + xtemp := STRCONC((first y).1," ") + xList := [xtemp,:xList] + y := rest y + xstring := bcwords2liststring xList + for i in 1..n repeat + gtemp := STRCONC((first y).1," ") + gList := [gtemp,:gList] + y := rest y + gstring := bcwords2liststring gList + while y repeat + f := STRCONC((first y).1," ") + fList := [f,:fList] + y := rest y + fstring := bcwords2liststring fList + prefix := STRCONC("d02raf(",STRINGIMAGE n,", ",STRINGIMAGE mnp,", ") + prefix := STRCONC(prefix,STRINGIMAGE numbeg,", ",STRINGIMAGE nummix,", ") + prefix := STRCONC(prefix,tol,", ",STRINGIMAGE init,", ",STRINGIMAGE iy,", ") + middle:= STRCONC(STRINGIMAGE ijac,", ",STRINGIMAGE lwork,", ") + middle := STRCONC(middle,STRINGIMAGE liwork,", ",STRINGIMAGE np,", [") + middle := STRCONC(middle,xstring,"],[[0.0 for i in 1..", STRINGIMAGE mnp) + middle := STRCONC(middle,"] for j in 1..",STRINGIMAGE iy,"]") + middle := STRCONC(middle,":: Matrix DoubleFloat,",STRINGIMAGE deleps,", ") + middle := STRCONC(middle,STRINGIMAGE ifail,", (",fstring,"::Vector ") + middle := STRCONC(middle,"Expression Float)::ASP41('FCN,'JACOBF,'JACEPS),(") + middle := STRCONC(middle,gstring,"::Vector Expression Float)::ASP42('G,'JACOBG,") + middle := STRCONC(middle,"'JACGEP))") + linkGen STRCONC(prefix,middle) + + +d02rafCopOut() == + htInitPage('"D02RAF - ODEs, general nonlinear boundary value problem, finite difference technique with deferred correction, continuation facility",nil) + htMakePage '( + (domainConditions + (isDomain PI (PositiveInteger))) + (text . "\blankline ") + (text . "{\center{\em Hyperdoc interface not available for initial mesh}}") + (text . "\newline ") + (text . "{\center{\em Please use the command line.}}")) + htMakeDoneButton('"Continue",'d02raf) + htShowPage() diff --git a/src/interp/nag-d02.boot.pamphlet b/src/interp/nag-d02.boot.pamphlet deleted file mode 100644 index fb0c00a4..00000000 --- a/src/interp/nag-d02.boot.pamphlet +++ /dev/null @@ -1,2170 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp nag-d02.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. - -@ -<<*>>= -<> - -)package "BOOT" - -d02bbf() == - htInitPage('"D02BBF - ODEs, IVP, Runge-Kutta-Merson method, over a range, intermediate output",nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXd02bbf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d02bbf| '|NagOrdinaryDifferentialEquationsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "D02BBF integrates a system of {\it n} ordinary differential ") - (text . "equations, {\htbitmap{yi}}' = {\htbitmap{fi}}(x,y), for ") - (text . "{\it i} = 1,2,...,{\it n}, over a range with given initial ") - (text . "conditions using a Runge-Kutta-Merson method; the solution ") - (text . "may be output at specified points.") - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Initial value of {\it x}:") - (text . "\newline\tab{2} ") - (bcStrings (5 "0.0" x F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "End of integration range {\it xend}:") - (text . "\newline\tab{2} ") - (bcStrings (5 "8.0" xend F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Number of differential equations {\it n}:") - (text . "\newline\tab{2} ") - (bcStrings (5 3 n PI)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") - (text . "\newline Tolerance required {\it tol}: ") - (text . "\newline\tab{2} ") - (bcStrings (10 "0.0001" tol F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Error control indicator {\it irelab}:") - (radioButtons irelab - ("" " 0, mixed" mix) - ("" " 1, absolute" abs) - ("" " 2, relative" rel)) - (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", 'd02bbfSolve) - htShowPage() - -d02bbfSolve htPage == - x := htpLabelInputString(htPage,'x) - xend := htpLabelInputString(htPage,'xend) - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - tol := htpLabelInputString(htPage,'tol) - control := htpButtonValue(htPage,'irelab) - irelab := - control = 'mix => '0 - control = 'abs => '1 - '2 - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'minusOne => '-1 - '1 - n = '3 => d02bbfDefaultSolve(htPage,x,xend,tol,irelab,ifail) - funcList := - "append"/[fa(i) for i in 1..n] where fa(i) == - prefix := ('"\newline {\em Function ") - prefix := STRCONC(prefix,STRINGIMAGE i,'":} \space{1}") - funct := STRCONC ('"Y[",STRINGIMAGE i ,"]") - nam := INTERN STRCONC ('"n",STRINGIMAGE i) - [['text,:prefix],['bcStrings,[42, funct, nam, 'EM]]] - middle := ('"\blankline \menuitemstyle{} \tab{2} Enter the initial ") - middle := STRCONC(middle,'"values of \htbitmap{yi}: \newline \tab{2}") - yList := - "append"/[fb(i) for i in 1..n] where fb(i) == - ynam := INTERN STRCONC ('"u",STRINGIMAGE i) - [['bcStrings,[6, 0, ynam, 'F]]] - yList := [['text,:middle],:yList] - mid:= ('"\blankline \menuitemstyle{} \tab{2} Intermediate values of {\it x}") - mid := STRCONC(mid,'" at which \htbitmap{yi} is required: \newline \tab{2}") - vList := [['bcStrings,[30, "0", 'out, 'EM]]] - vList := [['text,:mid],:vList] - equationPart := [ - '(domainConditions - (isDomain EM $EmptyMode) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain I (Integer))), - :funcList,:yList,:vList] - page := htInitPage('"D02BBF - ODEs, IVP, Runge-Kutta-Merson method, over a range, intermediate output",nil) - htSay '"\menuitemstyle{}\tab{2} " - htSay '"Enter the functions (i.e. the derivatives) below " - htSay '"as functions of Y[1]...Y[n]: " - htSay '"\newline " - htMakePage equationPart - htMakeDoneButton('"Continue",'d02bbfGen) - htpSetProperty(page,'x,x) - htpSetProperty(page,'xend,xend) - htpSetProperty(page,'n,n) - htpSetProperty(page,'tol,tol) - htpSetProperty(page,'irelab,irelab) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -d02bbfDefaultSolve(htPage,x,xend,tol,irelab,ifail) == - n := '3 - page := htInitPage('"D02BBF - ODEs, IVP, Runge-Kutta-Merson method, over a range, intermediate output",nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the functions (i.e. the derivatives) below ") - (text . "as functions of Y[1]...Y[n]: ") - (text . "\newline ") - (text . "\newline {\em Function 1:} \space{1}") - (bcStrings (44 "tan(Y[3])" f1 EM)) - (text . "\newline {\em Function 2:} \space{1}") - (bcStrings (44 "-0.032*tan(Y[3])/Y[2] -0.02*Y[2]/cos(Y[3])" f2 EM)) - (text . "\newline {\em Function 3:} \space{1}") - (bcStrings (44 "-0.032/(Y[2]**2)" f3 EM)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the initial values of \htbitmap{yi}:") - (text . "\newline \tab{2}") - (bcStrings (8 "0.0" y1 EM)) - (bcStrings (8 "0.5" y2 EM)) - (bcStrings (8 "\%pi*0.2" y3 EM)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Intermediate values of {\it x} at which \htbitmap{yi} is required:") - (text . "\newline \tab{2}") - (bcStrings (30 "1,2,3,4,5,6,7,8" out EM))) - htpSetProperty(page,'x,x) - htpSetProperty(page,'xend,xend) - htpSetProperty(page,'n,n) - htpSetProperty(page,'tol,tol) - htpSetProperty(page,'irelab,irelab) - htpSetProperty(page,'ifail,ifail) - htMakeDoneButton('"Continue",'d02bbfGen) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -d02bbfGen htPage == - x := htpProperty(htPage, 'x) - xend := htpProperty(htPage, 'xend) - n := htpProperty(htPage, 'n) - tol := htpProperty(htPage, 'tol) - irelab := htpProperty(htPage, 'irelab) - ifail := htpProperty(htPage, 'ifail) - alist := htpInputAreaAlist htPage - y := alist - outp := ((first y).1) - oList := [outp,:oList] - y := rest y - ostring := bcwords2liststring oList - -- This is distictly horrible! OUTP is a comma-seperated string so we - -- count up the commas to see how many elements it has. We return this - -- quantity plus 1 since the ASP OUTPUT is always called at least once. - numberOfPoints := - ZEROP LENGTH(outp) => 1 - 2+COUNT(CHARACTER(44),outp) - for i in 1..n repeat - ytemp := STRCONC((first y).1," ") - yList := [ytemp,:yList] - y := rest y - ystring := bcwords2liststring yList - while y repeat - f := STRCONC((first y).1," ") - fList := [f,:fList] - y := rest y - fstring := bcwords2liststring fList - prefix := STRCONC("d02bbf(", xend,", ", STRINGIMAGE numberOfPoints, ", ",STRINGIMAGE n,", ",STRINGIMAGE irelab) - prefix := STRCONC(prefix,", ",x,", [", ystring,"],",tol) - prefix := STRCONC(prefix,", ",STRINGIMAGE ifail,",(") - end := STRCONC(fstring,"::Vector Expression Float)::ASP7('FCN),(",ostring) - end := STRCONC(end,"::Vector MachineFloat)::ASP8('OUTPUT))") - linkGen STRCONC(prefix,end) - -d02bhf() == - htInitPage('"D02BHF - ODEs, IVP, Runge-Kutta-Merson method, until function of solution is zero",nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXd02bhf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d02bhf| '|NagOrdinaryDifferentialEquationsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "D02BHF integrates a system of {\it n} ordinary differential ") - (text . "equations, {\htbitmap{yi}}' = {\htbitmap{fi}}(x,y), for ") - (text . "{\it i} = 1,2,...,{\it n}, over a range with given initial ") - (text . "conditions using a Runge-Kutta-Merson method until a specified ") - (text . "function {\em g(x,y)} of the solution is zero. ") - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Initial value of {\it x}:") - (text . "\newline\tab{2} ") - (bcStrings (5 "0.0" x F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "End of integration range {\it xend}:") - (text . "\newline\tab{2} ") - (bcStrings (5 "10.0" xend F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Number of differential equations {\it n}:") - (text . "\newline\tab{2} ") - (bcStrings (5 3 n PI)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") - (text . "\newline Tolerance required {\it tol}: ") - (text . "\newline\tab{2} ") - (bcStrings (10 "0.0001" tol F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Error control indicator {\it irelab}:") - (radioButtons irelab - ("" " 0, mixed" mix) - ("" " 1, absolute" abs) - ("" " 2, relative" rel)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") - (text . "\newline Upper bound on size of the interval {\it hmax}: ") - (text . "\newline\tab{2} ") - (bcStrings (10 "0.0" hmax 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", 'd02bhfSolve) - htShowPage() - -d02bhfSolve htPage == - x := htpLabelInputString(htPage,'x) - xend := htpLabelInputString(htPage,'xend) - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - tol := htpLabelInputString(htPage,'tol) - control := htpButtonValue(htPage,'irelab) - irelab := - control = 'mix => '0 - control = 'abs => '1 - '2 - hmax := htpLabelInputString(htPage,'hmax) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - n = '3 => d02bhfDefaultSolve(htPage,x,xend,tol,irelab,hmax,ifail) - funcList := - "append"/[fa(i) for i in 1..n] where fa(i) == - prefix := ('"\newline {\em Function ") - prefix := STRCONC(prefix,STRINGIMAGE i,'":} \space{1}") - funct := STRCONC ('"Y[",STRINGIMAGE i ,"]") - nam := INTERN STRCONC ('"n",STRINGIMAGE i) - [['text,:prefix],['bcStrings,[42, funct, nam, 'EM]]] - middle := ('"\blankline \menuitemstyle{} \tab{2} Enter the initial ") - middle := STRCONC(middle,'"values of \htbitmap{yi}: \newline ") - yList := - "append"/[fb(i) for i in 1..n] where fb(i) == - ynam := INTERN STRCONC ('"u",STRINGIMAGE i) - [['bcStrings,[6, 0, ynam, 'F]]] - yList := [['text,:middle],:yList] - mid:= ('"\blankline \menuitemstyle{} \tab{2} Enter the function below ") - mid := STRCONC(mid,'"{\em g(x,y)}: \newline ") - vList := [['bcStrings,[30, '"Y[1]", 'g, 'EM]]] - vList := [['text,:mid],:vList] - equationPart := [ - '(domainConditions - (isDomain EM $EmptyMode) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain I (Integer))), - :funcList,:yList,:vList] - page := htInitPage('"D02BHF - ODEs, IVP, Runge-Kutta-Merson method, until function of solution is zero",nil) - htSay '"\menuitemstyle{}\tab{2} " - htSay '"Enter the functions (i.e. the derivatives) below \htbitmap{fi} " - htSay '"as functions of Y[1]...Y[n]: " - htSay '"\newline " - htMakePage equationPart - htMakeDoneButton('"Continue",'d02bhfGen) - htpSetProperty(page,'x,x) - htpSetProperty(page,'xend,xend) - htpSetProperty(page,'n,n) - htpSetProperty(page,'tol,tol) - htpSetProperty(page,'irelab,irelab) - htpSetProperty(page,'hmax,hmax) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -d02bhfDefaultSolve(htPage,x,xend,tol,irelab,hmax,ifail) == - n := '3 - page := htInitPage('"D02BHF - ODEs, IVP, Runge-Kutta-Merson method, until function of solution is zero",nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the functions (i.e. the derivatives) below \htbitmap{fi} ") - (text . "as functions of Y[1]...Y[n]: ") - (text . "\newline {\em Function 1:} \space{1}") - (bcStrings (44 "tan(Y[3])" f1 EM)) - (text . "\newline {\em Function 2:} \space{1}") - (bcStrings (44 "-0.032*tan(Y[3])/Y[2] -0.02*Y[2]/cos(Y[3])" f2 EM)) - (text . "\newline {\em Function 3:} \space{1}") - (bcStrings (44 "-0.032/(Y[2]**2)" f3 EM)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the initial values of \htbitmap{yi}:") - (text . "\newline ") - (bcStrings (8 "0.5" y1 EM)) - (bcStrings (8 "0.5" y2 EM)) - (bcStrings (8 "\%pi*0.2" y3 EM)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the function below {\em g(x,y)}: ") - (text . "\newline ") - (bcStrings (30 "Y[1]" g EM))) - htpSetProperty(page,'x,x) - htpSetProperty(page,'xend,xend) - htpSetProperty(page,'n,n) - htpSetProperty(page,'tol,tol) - htpSetProperty(page,'irelab,irelab) - htpSetProperty(page,'hmax,hmax) - htpSetProperty(page,'ifail,ifail) - htMakeDoneButton('"Continue",'d02bhfGen) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -d02bhfGen htPage == - x := htpProperty(htPage, 'x) - xend := htpProperty(htPage, 'xend) - n := htpProperty(htPage, 'n) - tol := htpProperty(htPage, 'tol) - irelab := htpProperty(htPage, 'irelab) - hmax := htpProperty(htPage, 'hmax) - ifail := htpProperty(htPage, 'ifail) - alist := htpInputAreaAlist htPage - y := alist - g := ((first y).1) - y := rest y - for i in 1..n repeat - ytemp := STRCONC((first y).1," ") - yList := [ytemp,:yList] - y := rest y - ystring := bcwords2liststring yList - while y repeat - f := STRCONC((first y).1," ") - fList := [f,:fList] - y := rest y - fstring := bcwords2liststring fList - prefix := STRCONC("d02bhf(", xend,", ",STRINGIMAGE n,", ",STRINGIMAGE irelab) - mid := STRCONC(", ",hmax,", ",x,", [", ystring,"],") - mid := STRCONC(mid,tol,", ",STRINGIMAGE ifail,",(",g) - mid := STRCONC(mid,"::Expression Float)::ASP9('G),(") - end := STRCONC(fstring,"::Vector Expression Float)::ASP7('FCN))") - linkGen STRCONC(prefix,mid,end) - - -d02cjf() == - htInitPage('"D02CJF - ODEs, IVP, Adams method, until function of solution is zero, intermediate output",nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXd02cjf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d02cjf| '|NagOrdinaryDifferentialEquationsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "D02CJF integrates a system of {\it n} ordinary differential ") - (text . "equations, {\htbitmap{yi}}' = {\htbitmap{fi}}(x,y), for ") - (text . "{\it i} = 1,2,...,{\it n}, over a range with given initial ") - (text . "conditions using an Adams method until a specified ") - (text . "function {\em g(x,y)} of the solution is zero; the solution may ") - (text . "be output at specified points. \blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Initial value of {\it x}:") - (text . "\newline\tab{2} ") - (bcStrings (5 "0.0" x F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "End of integration range {\it xend}:") - (text . "\newline\tab{2} ") - (bcStrings (5 "10.0" xend F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Number of differential equations {\it n}:") - (text . "\newline\tab{2} ") - (bcStrings (5 3 n PI)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") - (text . "\newline Tolerance required {\it tol}: ") - (text . "\newline\tab{2} ") - (bcStrings (10 "0.0001" tol F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Type of error test used {\it relabs}:") - (radioButtons relabs - ("" " D, default (mixed)" mix) - ("" " A, absolute" abs) - ("" " R, relative" rel)) - (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", 'd02cjfSolve) - htShowPage() - -d02cjfSolve htPage == - x := htpLabelInputString(htPage,'x) - xend := htpLabelInputString(htPage,'xend) - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - tol := htpLabelInputString(htPage,'tol) - control := htpButtonValue(htPage,'relabs) - relabs := - control = 'mix => '"D" - control = 'abs => '"A" - '"R" - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - n = '3 => d02cjfDefaultSolve(htPage,x,xend,tol,relabs,ifail) - funcList := - "append"/[fa(i) for i in 1..n] where fa(i) == - prefix := ('"\newline {\em Function ") - prefix := STRCONC(prefix,STRINGIMAGE i,'":} \space{1}") - funct := STRCONC ('"Y[",STRINGIMAGE i ,"]") - nam := INTERN STRCONC ('"n",STRINGIMAGE i) - [['text,:prefix],['bcStrings,[42, funct, nam, 'EM]]] - middle := ('"\blankline \menuitemstyle{} \tab{2} Enter the initial ") - middle := STRCONC(middle,'"values of \htbitmap{yi}: \newline ") - yList := - "append"/[fb(i) for i in 1..n] where fb(i) == - ynam := INTERN STRCONC ('"u",STRINGIMAGE i) - [['bcStrings,[6, 0, ynam, 'F]]] - yList := [['text,:middle],:yList] - mid:= ('"\blankline \menuitemstyle{} \tab{2} Intermediate values of {\it x}") - mid := STRCONC(mid,'" at which \htbitmap{yi} is required: \newline ") - vList := [['bcStrings,[30, "2,4", 'out, 'EM]]] - vList := [['text,:mid],:vList] - midd := ('"\blankline \menuitemstyle{} \tab{2} Enter the function below ") - midd := STRCONC(midd,'"{\em g(x,y)}: \newline ") - uList := [['bcStrings,[30, '"Y[1]", 'g, 'EM]]] - uList := [['text,:midd],:uList] - equationPart := [ - '(domainConditions - (isDomain EM $EmptyMode) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain I (Integer))), - :funcList,:yList,:vList,:uList] - page := htInitPage('"D02CJF - ODEs, IVP, Adams method, until function of solution is zero, intermediate output",nil) - htSay '"\menuitemstyle{}\tab{2} " - htSay '"Enter the functions (i.e. the derivatives) below \htbitmap{fi} " - htSay '"as functions of Y[1]...Y[n]: " - htSay '"\newline " - htMakePage equationPart - htMakeDoneButton('"Continue",'d02cjfGen) - htpSetProperty(page,'x,x) - htpSetProperty(page,'xend,xend) - htpSetProperty(page,'n,n) - htpSetProperty(page,'tol,tol) - htpSetProperty(page,'relabs,relabs) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -d02cjfDefaultSolve(htPage,x,xend,tol,relabs,ifail) == - n := '3 - page := htInitPage('"D02CJF - ODEs, IVP, Adams method, until function of solution is zero, intermediate output",nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the functions (i.e. the derivatives) below \htbitmap{fi} ") - (text . "as functions of Y[1]...Y[n]: ") - (text . "\newline {\em Function 1:} \space{1}") - (bcStrings (44 "tan(Y[3])" f1 EM)) - (text . "\newline {\em Function 2:} \space{1}") - (bcStrings (44 "-0.032*tan(Y[3])/Y[2] -0.02*Y[2]/cos(Y[3])" f2 EM)) - (text . "\newline {\em Function 3:} \space{1}") - (bcStrings (44 "-0.032/(Y[2]**2)" f3 EM)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the initial values of \htbitmap{yi}:") - (text . "\newline ") - (bcStrings (8 "0.5" y1 EM)) - (bcStrings (8 "0.5" y2 EM)) - (bcStrings (8 "\%pi*0.2" y3 EM)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} Intermediate") - (text . " values of {\it x} at which \htbitmap{yi} is required:") - (text . "\newline ") - (bcStrings (30 "2,4,6,8" out EM)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the function below {\em g(x,y)}: ") - (text . "\newline ") - (bcStrings (30 "Y[1]" g EM))) - htpSetProperty(page,'x,x) - htpSetProperty(page,'xend,xend) - htpSetProperty(page,'n,n) - htpSetProperty(page,'tol,tol) - htpSetProperty(page,'relabs,relabs) - htpSetProperty(page,'ifail,ifail) - htMakeDoneButton('"Continue",'d02cjfGen) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -d02cjfGen htPage == - x := htpProperty(htPage, 'x) - xend := htpProperty(htPage, 'xend) - n := htpProperty(htPage, 'n) - tol := htpProperty(htPage, 'tol) - relabs := htpProperty(htPage, 'relabs) - ifail := htpProperty(htPage, 'ifail) - alist := htpInputAreaAlist htPage - y := alist - g := ((first y).1) - y := rest y - outp := ((first y).1) - oList := [outp,:oList] - ostring := bcwords2liststring oList - -- This is distictly horrible! OUTP is a comma-seperated string so we - -- count up the commas to see how many elements it has. We return this - -- quantity plus 1 since the ASP OUTPUT is always called at least once. - numberOfPoints := - ZEROP LENGTH(outp) => 1 - 2+COUNT(CHARACTER(44),outp) - y := rest y - for i in 1..n repeat - ytemp := STRCONC((first y).1," ") - yList := [ytemp,:yList] - y := rest y - ystring := bcwords2liststring yList - while y repeat - f := STRCONC((first y).1," ") - fList := [f,:fList] - y := rest y - fstring := bcwords2liststring fList - prefix := STRCONC("d02cjf(",xend,", ",STRINGIMAGE numberOfPoints ,", ", STRINGIMAGE n,", ",tol,",_"",relabs) - mid := STRCONC("_", ",x ,", [", ystring,"],",STRINGIMAGE ifail) - mid := STRCONC(mid,",(",g,"::Expression Float)::ASP9('G),(",fstring) - end := STRCONC("::Vector Expression Float)::ASP7('FCN),(",ostring) - end := STRCONC(end,"::Vector MachineFloat)::ASP8('OUTPUT))") - linkGen STRCONC(prefix,mid,end) - - - -d02ejf() == - htInitPage('"D02EJF - ODEs, stiff IVP, BDF method, until function of solution is zero, intermediate output",nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXd02ejf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d02ejf| '|NagOrdinaryDifferentialEquationsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "D02EJF integrates a system of {\em n} ordinary differential ") - (text . "equations, {\htbitmap{yi}}' = {\htbitmap{fi}}(x,y), for {\it i} ") - (text . "= 1,,2,...,{\it n}, over a range with given initial conditions") - (text . " using backward differentiation formulae until a specified ") - (text . "function {\em g(x,y)} of the solution is zero; the solution may ") - (text . "be output at specified points. \blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Initial value of {\it x}:") - (text . "\newline\tab{2} ") - (bcStrings (5 "0.0" x F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "End of integration range {\it xend}:") - (text . "\newline\tab{2} ") - (bcStrings (5 "10.0" xend F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Number of differential equations {\it n}:") - (text . "\newline\tab{2} ") - (bcStrings (5 3 n PI)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") - (text . "\newline Tolerance required {\it tol}: ") - (text . "\newline\tab{2} ") - (bcStrings (10 "0.0001" tol F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Type of error test used {\it relabs}:") - (radioButtons relabs - ("" " D, default (mixed)" mix) - ("" " A, absolute" abs) - ("" " R, relative" rel)) - (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", 'd02ejfSolve) - htShowPage() - -d02ejfSolve htPage == - x := htpLabelInputString(htPage,'x) - xend := htpLabelInputString(htPage,'xend) - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - tol := htpLabelInputString(htPage,'tol) - control := htpButtonValue(htPage,'relabs) - relabs := - control = 'mix => '"D" - control = 'abs => '"A" - '"R" - iw := (n + 12) * n + 50 - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - n = '3 => d02ejfDefaultSolve(htPage,x,xend,tol,relabs,iw,ifail) - funcList := - "append"/[fa(i) for i in 1..n] where fa(i) == - prefix := ('"\newline {\em Function ") - prefix := STRCONC(prefix,STRINGIMAGE i,'":} \space{1}") - funct := STRCONC ('"Y[",STRINGIMAGE i ,"]") - nam := INTERN STRCONC ('"n",STRINGIMAGE i) - [['text,:prefix],['bcStrings,[42, funct, nam, 'EM]]] - middle := ('"\blankline \menuitemstyle{} \tab{2} Enter the initial ") - middle := STRCONC(middle,'"values of \htbitmap{yi}: \newline ") - yList := - "append"/[fb(i) for i in 1..n] where fb(i) == - ynam := INTERN STRCONC ('"u",STRINGIMAGE i) - [['bcStrings,[6, 0, ynam, 'F]]] - yList := [['text,:middle],:yList] - mid:= ('"\blankline \menuitemstyle{} \tab{2} Intermediate values of {\it x}") - mid := STRCONC(mid,'" at which \htbitmap{yi} is required: \newline ") - vList := [['bcStrings,[30, "2,4,6,8", 'out, 'EM]]] - vList := [['text,:mid],:vList] - midd := ('"\blankline \menuitemstyle{} \tab{2} Enter the function below ") - midd := STRCONC(midd,'"{\em g(x,y)}: \newline ") - uList := [['bcStrings,[30, '"Y[1]", 'g, 'EM]]] - uList := [['text,:midd],:uList] - equationPart := [ - '(domainConditions - (isDomain EM $EmptyMode) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain I (Integer))), - :funcList,:yList,:vList,:uList] - page := htInitPage('"D02EJF - ODEs, stiff IVP, BDF method, until function of solution is zero, intermediate output",nil) - htSay '"\menuitemstyle{}\tab{2} " - htSay '"Enter the functions (i.e. the derivatives) below \htbitmap{fi} " - htSay '"as functions of Y[1]...Y[n]: " - htSay '"\newline " - htMakePage equationPart - htSay '"\blankline {\em Note:} PEDERV is automatically generated using the vector " - htSay '"of derivatives given above. " - htMakeDoneButton('"Continue",'d02ejfGen) - htpSetProperty(page,'x,x) - htpSetProperty(page,'xend,xend) - htpSetProperty(page,'n,n) - htpSetProperty(page,'tol,tol) - htpSetProperty(page,'relabs,relabs) - htpSetProperty(page,'iw,iw) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -d02ejfDefaultSolve(htPage,x,xend,tol,relabs,iw,ifail) == - n := '3 - page := htInitPage('"D02EJF - ODEs, stiff IVP, BDF method, until function of solution is zero, intermediate output",nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the functions (i.e. the derivatives) below \htbitmap{fi} ") - (text . "as functions of Y[1]...Y[n]: ") - (text . "\newline {\em Function 1:} \space{1}") - (bcStrings (44 "-0.04*Y[1]+1.0E4*Y[2]*Y[3]" f1 EM)) - (text . "\newline {\em Function 2:} \space{1}") - (bcStrings (44 "0.04*Y[1]-1.0E4*Y[2]*Y[3]-3.0E7*Y[2]*Y[2]" f2 EM)) - (text . "\newline {\em Function 3:} \space{1}") - (bcStrings (44 "3.0E7*Y[2]*Y[2]" f3 EM)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the initial values of \htbitmap{yi}:") - (text . "\newline ") - (bcStrings (8 "1.0" y1 EM)) - (bcStrings (8 "0.0" y2 EM)) - (bcStrings (8 "0.0" y3 EM)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} Intermediate") - (text . " values of {\it x} at which \htbitmap{yi} is required:") - (text . "\newline ") - (bcStrings (30 "2,4,6,8" out EM)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the function below {\em g(x,y)}: ") - (text . "\newline ") - (bcStrings (30 "Y[1]-0.9" g EM)) - (text . "\blankline ") - (text . "{\em Note:} PEDERV is automatically generated using the vector ") - (text . "of derivatives given above. ")) - htpSetProperty(page,'x,x) - htpSetProperty(page,'xend,xend) - htpSetProperty(page,'n,n) - htpSetProperty(page,'tol,tol) - htpSetProperty(page,'relabs,relabs) - htpSetProperty(page,'iw,iw) - htpSetProperty(page,'ifail,ifail) - htMakeDoneButton('"Continue",'d02ejfGen) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -d02ejfGen htPage == - x := htpProperty(htPage, 'x) - xend := htpProperty(htPage, 'xend) - n := htpProperty(htPage, 'n) - tol := htpProperty(htPage, 'tol) - relabs := htpProperty(htPage, 'relabs) - iw := htpProperty(htPage, 'iw) - ifail := htpProperty(htPage, 'ifail) - alist := htpInputAreaAlist htPage - y := alist - g := ((first y).1) - y := rest y - outp := ((first y).1) - oList := [outp,:oList] - ostring := bcwords2liststring oList - -- This is distictly horrible! OUTP is a comma-seperated string so we - -- count up the commas to see how many elements it has. We return this - -- quantity plus 1 since the ASP OUTPUT is always called at least once. - numberOfPoints := - ZEROP LENGTH(outp) => 1 - 2+COUNT(CHARACTER(44),outp) - y := rest y - for i in 1..n repeat - ytemp := STRCONC((first y).1," ") - yList := [ytemp,:yList] - y := rest y - ystring := bcwords2liststring yList - while y repeat - f := STRCONC((first y).1," ") - fList := [f,:fList] - y := rest y - fstring := bcwords2liststring fList - prefix := STRCONC("d02ejf(",xend,", ",STRINGIMAGE numberOfPoints,", ", STRINGIMAGE n,",_"",relabs,"_", ") - mid:=STRCONC(STRINGIMAGE iw,", ",x ,", [", ystring,"], ",tol,", ") - mid := STRCONC(mid,STRINGIMAGE ifail,",(",g,"::Expression Float)::ASP9(G),(") - end := STRCONC(fstring,"::Vector Expression Float)::ASP7('FCN),(",fstring) - end := STRCONC(end,"::Vector Expression Float)::ASP31('PEDERV),(",ostring) - end := STRCONC(end,"::Vector MachineFloat)::ASP8('OUTPUT))") - linkGen STRCONC(prefix,mid,end) - -d02gaf() == - htInitPage('"D02GAF - ODEs, boundary value problem, finite difference technique with deferred correction, simple nonlinear problem", nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXd02gaf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d02gaf| '|NagOrdinaryDifferentialEquationsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "D02GAF solves a two-point boundary value problem for a system ") - (text . "of n ODEs \center{\htbitmap{d02gaf},} for i = 1,2,...,n, on ") - (text . "the range [a,b] with assigned boundary conditions using a ") - (text . "deferred correction technique and a Newton iteration; ") - (text . "the solution is computed on a mesh. ") - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the number of equations in the system {\it n}:") - (text . "\newline\tab{2} ") - (bcStrings (5 3 n PI)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") - (text . "\newline Left hand boundary point {\it a}: ") - (text . "\tab{32} \menuitemstyle{}\tab{34} ") - (text . "Right hand boundary {\it b}:") - (text . "\newline\tab{2} ") - (bcStrings (10 "0.0" a F)) - (text . "\tab{34} ") - (bcStrings (10 "10.0" b F)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") - (text . "\newline Max number of mesh points {\it mnp}:") - (text . "\tab{32} \menuitemstyle{}\tab{34} ") - (text . "Number of points {\it np} ({\it np} = 0 or {\it np} ") - (text . "\htbitmap{great=} 4): ") - (text . "\newline\tab{2} ") - (bcStrings (10 64 mnp PI)) - (text . "\tab{34} ") - (bcStrings (10 26 np PI)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Accuracy required {\it tol}:") - (text . "\newline\tab{2} ") - (bcStrings (10 "1.0e-3" tol F)) - (text . "\blankline ") - (text . "\newline \tab{2} ") - (text . "Ifail is input in three components: ") - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "{\it a} ") - (radioButtons afail - ("" " 0, hard failure" azero) - ("" " 1, soft failure" aone)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "{\it b} ") - (radioButtons bfail - ("" " 1, print error messages" bone) - ("" " 0, suppress error messages" bzero)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "{\it c} ") - (radioButtons cfail - ("" " 1, print warning messages" cone) - ("" " 0, suppress warning messages" czero))) - htMakeDoneButton('"Continue", 'd02gafSolve) - htShowPage() - -d02gafSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - a := htpLabelInputString(htPage,'a) - b := htpLabelInputString(htPage,'b) - mnp := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'mnp) - objValUnwrap htpLabelSpadValue(htPage, 'mnp) - np := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'np) - objValUnwrap htpLabelSpadValue(htPage, 'np) - lw := mnp * (3*n*n + 6*n + 2) + 4*n*n + 4*n - liw := mnp * (2*n + 1) + n*n + 4*n + 2 - tol := htpLabelInputString(htPage,'tol) - aerror := htpButtonValue(htPage,'afail) - afail := - aerror = 'azero => '0 - '1 - berror := htpButtonValue(htPage,'bfail) - bfail := - berror = 'bone => '1 - '0 - cerror := htpButtonValue(htPage,'cfail) - cfail := - cerror = 'cone => '1 - '0 - ifail := 100*cfail + 10*bfail + afail - n = '3 => d02gafDefaultSolve(htPage,a,b,mnp,np,lw,liw,tol,ifail) - funcList := - "append"/[fa(i) for i in 1..n] where fa(i) == - prefix := ('"\newline {\em Function ") - prefix := STRCONC(prefix,STRINGIMAGE i,'":} \space{1}") - funct := STRCONC ('"Y[",STRINGIMAGE i ,"]") - nam := INTERN STRCONC ('"n",STRINGIMAGE i) - [['text,:prefix],['bcStrings,[42, funct, nam, 'EM]]] - middle := ('"\blankline \menuitemstyle{} \tab{2} Enter known or estimated ") - middle := STRCONC(middle,'"values of \htbitmap{yi} at a and b, ") - middle := STRCONC(middle,"{\it U(n,2)}. [\htbitmap{yi}(a) in the first ") - middle := STRCONC(middle,"column, \htbitmap{yi}(b) in the second.] ") - middle := STRCONC(middle,"\newline ") - uList := - "append"/[fb(i) for i in 1..n] where fb(i) == - labelList := - "append"/[fc(i,j) for j in 1..2] where fc(i,j) == - unam := INTERN STRCONC ('"u",STRINGIMAGE i,STRINGIMAGE j) - [['bcStrings,[6, 0, unam, 'F]]] - prefix := ('"\newline ") - labelList := [['text,:prefix],:labelList] - uList := [['text,:middle],:uList] - mid := ('"\blankline \menuitemstyle{} \tab{2} Enter {\it V(n,2)}. ") - mid := STRCONC(mid,'"If U(i,j) is known V(i,j) ") - mid := STRCONC(mid,'"= 0.0, else V(i,j) = 1.0. \newline ") - vList := - "append"/[fd(i) for i in 1..n] where fd(i) == - labelList := - "append"/[fe(i,j) for j in 1..2] where fe(i,j) == - vnam := INTERN STRCONC ('"v",STRINGIMAGE i,STRINGIMAGE j) - [['bcStrings,[6, 0, vnam, 'F]]] - prefix := ('"\newline ") - labelList := [['text,:prefix],:labelList] - vList := [['text,:mid],:vList] - xList := - "append"/[ff(i) for i in 1..mnp] where ff(i) == - xnam := INTERN STRCONC ('"x",STRINGIMAGE i) - [['bcStrings,[8, "0.0", xnam, 'F]]] - end := ('"\blankline \menuitemstyle{} \tab{2} Enter the initial mesh ") - end := STRCONC(end,'"{\it X(mnp)}: \newline ") - xList := [['text,:end],:xList] - equationPart := [ - '(domainConditions - (isDomain EM $EmptyMode) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain I (Integer))), - :funcList,:uList,:vList,:xList] - page := htInitPage('"D02GAF - ODEs, boundary value problem, finite difference technique with deferred correction, simple nonlinear problem", nil) - htSay '"\menuitemstyle{}\tab{2} " - htSay '"Enter the functions (i.e. the derivatives) below as functions of " - htSay '"Y[1]...Y[n]: " - htSay '"\newline " - htMakePage equationPart - htMakeDoneButton('"Continue",'d02gafGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'a,a) - htpSetProperty(page,'b,b) - htpSetProperty(page,'mnp,mnp) - htpSetProperty(page,'np,np) - htpSetProperty(page,'lw,lw) - htpSetProperty(page,'liw,liw) - htpSetProperty(page,'tol,tol) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -d02gafDefaultSolve(htPage,a,b,mnp,np,lw,liw,tol,ifail) == - n := '3 - page := htInitPage('"D02GAF - ODEs, boundary value problem, finite difference technique with deferred correction, simple nonlinear problem", nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the functions (i.e. the derivatives) below ") - (text . "as functions of Y[1]...Y[n]: ") - (text . "\newline ") - (text . "\newline {\em Function 1:} \space{1}") - (bcStrings (42 "Y[2]" f1 EM)) - (text . "\newline {\em Function 2:} \space{1}") - (bcStrings (42 "Y[3]" f2 EM)) - (text . "\newline {\em Function 3:} \space{1}") - (bcStrings (42 "-Y[1]*Y[3]-0.2*(1-Y[2]*Y[2])" f3 EM)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter known or estimated values of \htbitmap{yi} at a and b,") - (text . " {\it U(n,2)}. ") - (text . " [\htbitmap{yi}(a) in the first column, \htbitmap{yi}(b) ") - (text . "in the second.] \newline ") - (bcStrings (6 "0" u11 F)) - (bcStrings (6 "10" u21 F)) - (text . "\newline ") - (bcStrings (6 "0" u12 F)) - (bcStrings (6 "1" u22 F)) - (text . "\newline ") - (bcStrings (6 "0" u13 F)) - (bcStrings (6 "0" u23 F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter {\it V(n,2)}. ") - (text . "If U(i,j) is known V(i,j) = 0.0, else V(i,j) = 1.0: \newline") - (bcStrings (6 "0.0" v11 F)) - (bcStrings (6 "1.0" v21 F)) - (text . "\newline ") - (bcStrings (6 "0.0" v12 F)) - (bcStrings (6 "0.0" v22 F)) - (text . "\newline ") - (bcStrings (6 "1.0" v13 F)) - (bcStrings (6 "1.0" v23 F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Enter the initial mesh {\it X(mnp)}: ") - (text . "\newline ") - (bcStrings (8 "0.0" x1 F)) - (bcStrings (8 "0.4" x2 F)) - (bcStrings (8 "0.8" x3 F)) - (bcStrings (8 "1.2" x4 F)) - (bcStrings (8 "1.6" x5 F)) - (bcStrings (8 "2.0" x6 F)) - (bcStrings (8 "2.4" x7 F)) - (bcStrings (8 "2.8" x8 F)) - (bcStrings (8 "3.2" x9 F)) - (bcStrings (8 "3.6" x10 F)) - (bcStrings (8 "4.0" x11 F)) - (bcStrings (8 "4.4" x12 F)) - (bcStrings (8 "4.8" x13 F)) - (bcStrings (8 "5.2" x14 F)) - (bcStrings (8 "5.6" x15 F)) - (bcStrings (8 "6.0" x16 F)) - (bcStrings (8 "6.4" x17 F)) - (bcStrings (8 "6.8" x18 F)) - (bcStrings (8 "7.2" x19 F)) - (bcStrings (8 "7.6" x20 F)) - (bcStrings (8 "8.0" x21 F)) - (bcStrings (8 "8.4" x22 F)) - (bcStrings (8 "8.8" x23 F)) - (bcStrings (8 "9.2" x24 F)) - (bcStrings (8 "9.6" x25 F)) - (bcStrings (8 "10.0" x26 F)) - (bcStrings (8 "0.0" x27 F)) - (bcStrings (8 "0.0" x28 F)) - (bcStrings (8 "0.0" x29 F)) - (bcStrings (8 "0.0" x30 F)) - (bcStrings (8 "0.0" x31 F)) - (bcStrings (8 "0.0" x32 F)) - (bcStrings (8 "0.0" x33 F)) - (bcStrings (8 "0.0" x34 F)) - (bcStrings (8 "0.0" x35 F)) - (bcStrings (8 "0.0" x36 F)) - (bcStrings (8 "0.0" x37 F)) - (bcStrings (8 "0.0" x38 F)) - (bcStrings (8 "0.0" x39 F)) - (bcStrings (8 "0.0" x40 F)) - (bcStrings (8 "0.0" x41 F)) - (bcStrings (8 "0.0" x42 F)) - (bcStrings (8 "0.0" x43 F)) - (bcStrings (8 "0.0" x44 F)) - (bcStrings (8 "0.0" x45 F)) - (bcStrings (8 "0.0" x46 F)) - (bcStrings (8 "0.0" x47 F)) - (bcStrings (8 "0.0" x48 F)) - (bcStrings (8 "0.0" x49 F)) - (bcStrings (8 "0.0" x50 F)) - (bcStrings (8 "0.0" x51 F)) - (bcStrings (8 "0.0" x52 F)) - (bcStrings (8 "0.0" x53 F)) - (bcStrings (8 "0.0" x54 F)) - (bcStrings (8 "0.0" x55 F)) - (bcStrings (8 "0.0" x56 F)) - (bcStrings (8 "0.0" x57 F)) - (bcStrings (8 "0.0" x58 F)) - (bcStrings (8 "0.0" x59 F)) - (bcStrings (8 "0.0" x60 F)) - (bcStrings (8 "0.0" x61 F)) - (bcStrings (8 "0.0" x62 F)) - (bcStrings (8 "0.0" x63 F)) - (bcStrings (8 "0.0" x64 F))) - htpSetProperty(page,'n,n) - htpSetProperty(page,'a,a) - htpSetProperty(page,'b,b) - htpSetProperty(page,'mnp,mnp) - htpSetProperty(page,'np,np) - htpSetProperty(page,'lw,lw) - htpSetProperty(page,'liw,liw) - htpSetProperty(page,'tol,tol) - htpSetProperty(page,'ifail,ifail) - htMakeDoneButton('"Continue",'d02gafGen) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -d02gafGen htPage == - n := htpProperty(htPage, 'n) - a := htpProperty(htPage, 'a) - b := htpProperty(htPage, 'b) - mnp := htpProperty(htPage, 'mnp) - np := htpProperty(htPage, 'np) - lw := htpProperty(htPage, 'lw) - liw := htpProperty(htPage, 'liw) - ifail := htpProperty(htPage,'ifail) - tol := htpProperty(htPage,'tol) - alist := htpInputAreaAlist htPage - y := alist - for i in 1..mnp repeat - x := STRCONC((first y).1," ") - xList := [x,:xList] - y := rest y - xstring := bcwords2liststring xList - for i in 1..n repeat - for j in 1..2 repeat - v := STRCONC((first y).1," ") - rowList := [v,:rowList] - y := rest y - vList := [:vList,rowList] - rowList := [] - for i in 1..n repeat - for j in 1..2 repeat - u := STRCONC((first y).1," ") - rowList := [u,:rowList] - y := rest y - uList := [:uList,rowList] - rowList := [] - vList := reverse vList - uList := reverse uList - vstring := bcwords2liststring [bcwords2liststring x for x in vList] - ustring := bcwords2liststring [bcwords2liststring x for x in uList] - while y repeat - f := STRCONC((first y).1," ") - fList := [f,:fList] - y := rest y - fstring := bcwords2liststring fList - Y:='Y - prefix := STRCONC("d02gaf(",ustring,", ",vstring,", ",STRINGIMAGE n,", ") - prefix := STRCONC(prefix,a,", ",b,", ",tol,", ") - prefix := STRCONC(prefix,STRINGIMAGE mnp,", ",STRINGIMAGE lw,", ") - prefix := STRCONC(prefix,STRINGIMAGE liw,", [",xstring,"], ",STRINGIMAGE np) - end:=STRCONC (",",STRINGIMAGE ifail,",(",fstring,"::Vector Expression Float") - linkGen STRCONC (prefix,end,")::ASP7('FCN))") - -d02gbf() == - htInitPage('"D02GBF - ODEs, boundary value problem, finite difference technique with deferred correction, general nonlinear problem", nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXd02gbf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d02gbf| '|NagOrdinaryDifferentialEquationsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "D02GBF solves a general linear two-point boundary value problem ") - (text . "for a system of n ODEs {\it y' = F(x)y + g(x)} on the range ") - (text . "[a,b] with boundary conditions {\it Cy(a) + Dy(b) = \gamma} ") - (text . "using a deferred correction technique.") - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the number of equations in the system {\it n}:") - (text . "\newline\tab{2} ") - (bcStrings (5 2 n PI)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") - (text . "\newline Left hand boundary point {\it a}: ") - (text . "\tab{32} \menuitemstyle{}\tab{34} ") - (text . "Right hand boundary {\it b}:") - (text . "\newline\tab{2} ") - (bcStrings (10 "0.0" a F)) - (text . "\tab{34} ") - (bcStrings (10 "1.0" b F)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") - (text . "\newline Max number of mesh points {\it mnp}:") - (text . "\tab{32} \menuitemstyle{}\tab{34} ") - (text . "Number of points {\it np}: ") - (text . "\newline\tab{2} ") - (bcStrings (10 70 mnp PI)) - (text . "\tab{34} ") - (bcStrings (10 0 np PI)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Accuracy required {\it tol}:") - (text . "\newline\tab{2} ") - (bcStrings (10 "1.0e-3" tol F)) - (text . "\blankline ") - (text . "\newline \tab{2} ") - (text . "Ifail is input in three components: ") - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "{\it a} ") - (radioButtons afail - ("" " 0, hard failure" azero) - ("" " 1, soft failure" aone)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "{\it b} ") - (radioButtons bfail - ("" " 1, print error messages" bone) - ("" " 0, suppress error messages" bzero)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "{\it c} ") - (radioButtons cfail - ("" " 1, print warning messages" cone) - ("" " 0, suppress warning messages" czero))) - htMakeDoneButton('"Continue", 'd02gbfSolve) - htShowPage() - -d02gbfSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - a := htpLabelInputString(htPage,'a) - b := htpLabelInputString(htPage,'b) - mnp := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'mnp) - objValUnwrap htpLabelSpadValue(htPage, 'mnp) - np := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'np) - objValUnwrap htpLabelSpadValue(htPage, 'np) - lw := mnp * (3*n*n + 5*n + 2) + 3*n*n + 5*n - liw := mnp * (2*n + 1) + n - tol := htpLabelInputString(htPage,'tol) - aerror := htpButtonValue(htPage,'afail) - afail := - aerror = 'azero => '0 - '1 - berror := htpButtonValue(htPage,'bfail) - bfail := - berror = 'bone => '1 - '0 - cerror := htpButtonValue(htPage,'cfail) - cfail := - cerror = 'cone => '1 - '0 - ifail := 100*cfail + 10*bfail + afail - n = '2 => d02gbfDefaultSolve(htPage,a,b,mnp,np,lw,liw,tol,ifail) - cList := - "append"/[fa(i,n) for i in 1..n] where fa(i,n) == - labelList := - "append"/[fb(i,j) for j in 1..n] where fb(i,j) == - cnam := INTERN STRCONC ('"c",STRINGIMAGE i,STRINGIMAGE j) - [['bcStrings,[6, 0, cnam, 'F]]] - prefix := ('"\newline ") - labelList := [['text,:prefix],:labelList] - middle := ('"\blankline \menuitemstyle{} \tab{2} Enter the matrix {\it D}: ") - middle := STRCONC(middle,"\newline ") - dList := - "append"/[fc(i,n) for i in 1..n] where fc(i,n) == - labelList := - "append"/[fd(i,j) for j in 1..n] where fd(i,j) == - dnam := INTERN STRCONC ('"d",STRINGIMAGE i,STRINGIMAGE j) - [['bcStrings,[6, 0, dnam, 'F]]] - prefix := ('"\newline ") - labelList := [['text,:prefix],:labelList] - dList := [['text,:middle],:dList] - middle := ('"\blankline \menuitemstyle{} \tab{2} Enter the vector \gamma: ") - middle := STRCONC(middle,"\newline ") - gamList := - "append"/[fe(i) for i in 1..n] where fe(i) == - gamnam := INTERN STRCONC ('"gam",STRINGIMAGE i) - [['bcStrings,[6, 0, gamnam, 'F]]] - prefix := ('"\newline ") - gamList := [['text,:middle],:gamList] - middle := ('"\blankline \menuitemstyle{} \tab{2} Enter the matrix ") - middle := STRCONC(middle,"{\it F(x)} from the equation {\it y' =} ") - middle := STRCONC(middle,"{\it F(x)y + g(x)}: \newline ") - fList := - "append"/[ff(i,n) for i in 1..n] where ff(i,n) == - labelList := - "append"/[fg(i,j) for j in 1..n] where fg(i,j) == - fnam := INTERN STRCONC ('"f",STRINGIMAGE i,STRINGIMAGE j) - [['bcStrings,[6, 0, fnam, 'F]]] - prefix := ('"\newline ") - labelList := [['text,:prefix],:labelList] - fList := [['text,:middle],:fList] - mid := ('"\blankline \menuitemstyle{} \tab{2} Enter the vector {\it g(x)}: ") - mid := STRCONC(mid,'"\newline ") - gList := - "append"/[fh(i) for i in 1..n] where fh(i) == - gnam := INTERN STRCONC ('"g",STRINGIMAGE i) - [['bcStrings,[6, 0, gnam, 'F]]] - prefix := ('"\newline ") - gList := [['text,:middle],:gList] - xList := - "append"/[fi(i) for i in 1..mnp] where fi(i) == - xnam := INTERN STRCONC ('"x",STRINGIMAGE i) - [['bcStrings,[8, "0.0", xnam, 'F]]] - end := ('"\blankline \menuitemstyle{} \tab{2} The initial mesh {\it X(mnp)}") - end := STRCONC(end,'", (all entries = 0 if np < 4): \newline ") - xList := [['text,:end],:xList] - equationPart := [ - '(domainConditions - (isDomain EM $EmptyMode) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain I (Integer))), - :cList,:dList,:gamList,:fList,:gList,:xList] - page := htInitPage('"D02GBF - ODEs, boundary value problem, finite difference technique with deferred correction, general nonlinear problem", nil) - htSay '"\menuitemstyle{}\tab{2} " - htSay '"Enter the matrix {\it C} form the equation {\it Cy(a) + Dy(b)} " - htSay '"= \gamma \newline " - htMakePage equationPart - htMakeDoneButton('"Continue",'d02gbfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'a,a) - htpSetProperty(page,'b,b) - htpSetProperty(page,'mnp,mnp) - htpSetProperty(page,'np,np) - htpSetProperty(page,'lw,lw) - htpSetProperty(page,'liw,liw) - htpSetProperty(page,'tol,tol) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -d02gbfDefaultSolve(htPage,a,b,mnp,np,lw,liw,tol,ifail) == - n := '2 - page := htInitPage('"D02GBF - ODEs, boundary value problem, finite difference technique with deferred correction, general nonlinear problem", nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the matrix {\it C} from the equation {\it Cy(a) + Dy(b)} = \gamma:") - (text . "\newline ") - (bcStrings (6 "1" c11 F)) - (bcStrings (6 "0" c12 F)) - (text . "\newline ") - (bcStrings (6 "0" c21 F)) - (bcStrings (6 "0" c22 F)) - (text . "\blankline \menuitemstyle{}\tab{2}") - (text . "Enter the matrix {\it D}: \newline ") - (bcStrings (6 "0" d11 F)) - (bcStrings (6 "0" d12 F)) - (text . "\newline ") - (bcStrings (6 "1" d21 F)) - (bcStrings (6 "0" d22 F)) - (text . "\blankline \menuitemstyle{}\tab{2}") - (text . "Enter the vector \gamma: \newline ") - (bcStrings (6 "0" gam1 F)) - (bcStrings (6 "1" gam2 F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the matrix {\it F(x)} from the equation {\it y' = F(x)y + g(x)} : ") - (text . "\newline ") - (bcStrings (6 "0" f11 F)) - (bcStrings (6 "1" f12 F)) - (text . "\newline ") - (bcStrings (6 "0" f21 F)) - (bcStrings (6 "-10" f22 F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the vector {\it g(x)}: ") - (text . "\newline ") - (bcStrings (6 "0" g1 F)) - (bcStrings (6 "0" g2 F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} The initial mesh {\it X(mnp)}, ") - (text . "(all entries = 0 if np < 4): \newline ") - (bcStrings (8 "0.0" x1 F)) - (bcStrings (8 "0.0" x2 F)) - (bcStrings (8 "0.0" x3 F)) - (bcStrings (8 "0.0" x4 F)) - (bcStrings (8 "0.0" x5 F)) - (bcStrings (8 "0.0" x6 F)) - (bcStrings (8 "0.0" x7 F)) - (bcStrings (8 "0.0" x8 F)) - (bcStrings (8 "0.0" x9 F)) - (bcStrings (8 "0.0" x10 F)) - (bcStrings (8 "0.0" x11 F)) - (bcStrings (8 "0.0" x12 F)) - (bcStrings (8 "0.0" x13 F)) - (bcStrings (8 "0.0" x14 F)) - (bcStrings (8 "0.0" x15 F)) - (bcStrings (8 "0.0" x16 F)) - (bcStrings (8 "0.0" x17 F)) - (bcStrings (8 "0.0" x18 F)) - (bcStrings (8 "0.0" x19 F)) - (bcStrings (8 "0.0" x20 F)) - (bcStrings (8 "0.0" x21 F)) - (bcStrings (8 "0.0" x22 F)) - (bcStrings (8 "0.0" x23 F)) - (bcStrings (8 "0.0" x24 F)) - (bcStrings (8 "0.0" x25 F)) - (bcStrings (8 "0.0" x26 F)) - (bcStrings (8 "0.0" x27 F)) - (bcStrings (8 "0.0" x28 F)) - (bcStrings (8 "0.0" x29 F)) - (bcStrings (8 "0.0" x30 F)) - (bcStrings (8 "0.0" x31 F)) - (bcStrings (8 "0.0" x32 F)) - (bcStrings (8 "0.0" x33 F)) - (bcStrings (8 "0.0" x34 F)) - (bcStrings (8 "0.0" x35 F)) - (bcStrings (8 "0.0" x36 F)) - (bcStrings (8 "0.0" x37 F)) - (bcStrings (8 "0.0" x38 F)) - (bcStrings (8 "0.0" x39 F)) - (bcStrings (8 "0.0" x40 F)) - (bcStrings (8 "0.0" x41 F)) - (bcStrings (8 "0.0" x42 F)) - (bcStrings (8 "0.0" x43 F)) - (bcStrings (8 "0.0" x44 F)) - (bcStrings (8 "0.0" x45 F)) - (bcStrings (8 "0.0" x46 F)) - (bcStrings (8 "0.0" x47 F)) - (bcStrings (8 "0.0" x48 F)) - (bcStrings (8 "0.0" x49 F)) - (bcStrings (8 "0.0" x50 F)) - (bcStrings (8 "0.0" x51 F)) - (bcStrings (8 "0.0" x52 F)) - (bcStrings (8 "0.0" x53 F)) - (bcStrings (8 "0.0" x54 F)) - (bcStrings (8 "0.0" x55 F)) - (bcStrings (8 "0.0" x56 F)) - (bcStrings (8 "0.0" x57 F)) - (bcStrings (8 "0.0" x58 F)) - (bcStrings (8 "0.0" x59 F)) - (bcStrings (8 "0.0" x60 F)) - (bcStrings (8 "0.0" x61 F)) - (bcStrings (8 "0.0" x62 F)) - (bcStrings (8 "0.0" x63 F)) - (bcStrings (8 "0.0" x64 F)) - (bcStrings (8 "0.0" x65 F)) - (bcStrings (8 "0.0" x66 F)) - (bcStrings (8 "0.0" x67 F)) - (bcStrings (8 "0.0" x68 F)) - (bcStrings (8 "0.0" x69 F)) - (bcStrings (8 "0.0" x70 F))) - htpSetProperty(page,'n,n) - htpSetProperty(page,'a,a) - htpSetProperty(page,'b,b) - htpSetProperty(page,'mnp,mnp) - htpSetProperty(page,'np,np) - htpSetProperty(page,'lw,lw) - htpSetProperty(page,'liw,liw) - htpSetProperty(page,'tol,tol) - htpSetProperty(page,'ifail,ifail) - htMakeDoneButton('"Continue",'d02gbfGen) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -d02gbfGen htPage == - n := htpProperty(htPage, 'n) - a := htpProperty(htPage, 'a) - b := htpProperty(htPage, 'b) - mnp := htpProperty(htPage, 'mnp) - np := htpProperty(htPage, 'np) - lw := htpProperty(htPage, 'lw) - liw := htpProperty(htPage, 'liw) - ifail := htpProperty(htPage,'ifail) - tol := htpProperty(htPage,'tol) - alist := htpInputAreaAlist htPage - y := alist - for i in 1..mnp repeat -- matrix - x := STRCONC((first y).1," ") - xList := [x,:xList] - y := rest y - xstring := bcwords2liststring xList - for i in 1..n repeat -- vector g - g := STRCONC((first y).1," ") - gList := [g,:gList] - y := rest y - gstring := bcwords2liststring gList - for i in 1..n repeat -- matrix F - for j in 1..n repeat - f := STRCONC((first y).1," ") - flist := [f,:flist] - y := rest y - fmatlist := [:fmatlist,flist] - flist := [] - fmatlist := reverse fmatlist - fmatstr := bcwords2liststring [bcwords2liststring x for x in fmatlist] - for i in 1..n repeat -- vector gamma - gam := STRCONC((first y).1," ") - gamList := [gam,:gamList] - y := rest y - gamstr := bcwords2liststring gamList - for i in 1..n repeat -- matrix D - for j in 1..n repeat - d := STRCONC((first y).1," ") - dlist := [d,:dlist] - y := rest y - dmatlist := [:dmatlist,dlist] - dlist := [] - dmatlist := reverse dmatlist - dmatstr := bcwords2liststring [bcwords2liststring x for x in dmatlist] - for i in 1..n repeat -- matrix C - for j in 1..n repeat - c := STRCONC((first y).1," ") - clist := [c,:clist] - y := rest y - cmatlist := [:cmatlist,clist] - clist := [] - cmatlist := reverse cmatlist - cmatstr := bcwords2liststring [bcwords2liststring x for x in cmatlist] - prefix := STRCONC("d02gbf(",STRINGIMAGE a,", ",STRINGIMAGE b,", ") - prefix := STRCONC(prefix,STRINGIMAGE n,", ",tol,", ",STRINGIMAGE mnp,", ") - prefix := STRCONC(prefix,STRINGIMAGE lw,", ",STRINGIMAGE liw,", ") - prefix := STRCONC(prefix,cmatstr,"::Matrix DoubleFloat,",dmatstr,"::Matrix DoubleFloat,[",gamstr,"]::Matrix DoubleFloat,[",xstring,"]::Matrix DoubleFloat, ") - mid := STRCONC(STRINGIMAGE np,", ",STRINGIMAGE ifail,", ") - end := STRCONC("(",fmatstr,"::Matrix(Expression(Float)))::ASP77(FCNF),(",gstring) - linkGen STRCONC(prefix,mid,end,"::Vector(Expression(Float)))::ASP78(FCNG))") - -d02kef() == - htInitPage('"D02KEF - 2nd order Sturm-Liouville problem, regular/singular system, finite/infinite range, eigenvalue and eigenfunction, user-specified break-points", nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXd02kef} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d02kef| '|NagOrdinaryDifferentialEquationsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "D02KEF finds a specified eigenvalue \htbitmap{lamdab} of a ") - (text . "regular or second-order Sturm-Liouville system ") - (text . "{\it(p(x)y')' + q(x; \lambda)y = 0} on a finite or infinite ") - (text . "range [a,b]; a Pruefer transformation and shooting method ") - (text . "are used; discontinuities in coefficient functions or their ") - (text . "derivatives are permitted. ") - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Number of points in XPOINT {\it m}:") - (text . "\newline\tab{2} ") - (bcStrings (6 5 m PI)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") - (text . "\newline Index of the `break-point' {\it match}:") - (text . "\newline\tab{2} ") - (bcStrings (6 0 match PI)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") - (text . "\newline Index of the required eigenvalue {\it k}:") - (text . "\newline\tab{2} ") - (bcStrings (6 11 k PI)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Accuracy required {\it tol}:") - (text . "\newline\tab{2} ") - (bcStrings (10 "0.0001" tol F)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} \newline ") - (text . "Eigenvalue estimate {\it elam}: ") - (text . "\tab{32} \menuitemstyle{}\tab{34} ") - (text . "Scale of the problem {\it delam}: ") - (text . "\newline\tab{2} ") - (bcStrings (10 "14" elam F)) - (text . "\tab{34} ") - (bcStrings (10 "1" delam F)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} \newline ") - (text . "Max iterations {\it maxit}:") - (text . "\tab{32} \menuitemstyle{}\tab{34} ") - (text . "Max COEFFN calls {\it maxfun}:") - (text . "\newline\tab{2} ") - (bcStrings (10 0 maxit PI)) - (text . "\tab{34} ") - (bcStrings (10 0 maxfun PI)) - (text . "\blankline ") - (text . "\tab{2} \newline {\it Note:} no bound is assumed ") - (text . "if maxit = 0 \blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Ifail value:") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'd02kefSolve) - htShowPage() - -d02kefSolve htPage == - m := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) - objValUnwrap htpLabelSpadValue(htPage, 'm) - match := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'match) - objValUnwrap htpLabelSpadValue(htPage, 'match) - k := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'k) - objValUnwrap htpLabelSpadValue(htPage, 'k) - tol := htpLabelInputString(htPage,'tol) - elam := htpLabelInputString(htPage,'elam) - delam := htpLabelInputString(htPage,'delam) - maxit := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'maxit) - objValUnwrap htpLabelSpadValue(htPage, 'maxit) - maxfun := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'maxfun) - objValUnwrap htpLabelSpadValue(htPage, 'maxfun) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'minusOne => '-1 - '1 - m = '5 =>d02kefDefaultSolve(htPage,match,k,tol,elam,delam,maxit,maxfun,ifail) - xpList := - "append"/[fa(i) for i in 1..m] where fa(i) == - xpnam := INTERN STRCONC ('"xp",STRINGIMAGE i) - [['bcStrings,[10, "0.0", xpnam, 'EM]]] - middle:=('"\blankline \menuitemstyle{} \tab{2} Value of {\it p} for COEFFN:") - middle := STRCONC(middle,"\newline ") - cList := [['text,:middle],['bcStrings,[42, "0.0", 'c1, 'EM]]] - middle:=('"\blankline \menuitemstyle{} \tab{2} Value of {\it q} for COEFFN:") - middle := STRCONC(middle,"\newline ") - c1List := [['text,:middle],['bcStrings,[42, "0.0", 'c2, 'EM]]] - cList := [:cList,:c1List] - middle:=('"\blankline \menuitemstyle{} \tab{2} Value of {\it dqdl}") - middle := STRCONC(middle," for COEFFN: \newline ") - c2List := [['text,:middle],['bcStrings,[42, "0.0", 'c3, 'EM]]] - cList := [:cList,:c2List] - middle:=('"\blankline \menuitemstyle{} \tab{2} Values of YL(1) & YL(2) ") - middle := STRCONC(middle,"for BDYVAL: \newline ") - ylList := - "append"/[fb(i) for i in 1..2] where fb(i) == - ylnam := INTERN STRCONC ('"yl",STRINGIMAGE i) - [['bcStrings,[42, "0.0", ylnam, 'EM]]] - ylList := [['text,:middle],:ylList] - middle:=('"\blankline \menuitemstyle{} \tab{2} Values of YR(1) & YR(2) ") - middle := STRCONC(middle,"for BDYVAL: \newline ") - yrList := - "append"/[fc(i) for i in 1..2] where fc(i) == - yrnam := INTERN STRCONC ('"yr",STRINGIMAGE i) - [['bcStrings,[42, "0.0", yrnam, 'EM]]] - yrList := [['text,:middle],:yrList] - middle:=('"\blankline \menuitemstyle{} \tab{2} Maximum step size ") - middle := STRCONC(middle,"{\it hmax(2,m)}: \newline ") - hList := - "append"/[fd(i,m) for i in 1..2] where fd(i,m) == - labelList := - "append"/[fe(i,j) for j in 1..m] where fe(i,j) == - hnam := INTERN STRCONC ('"h",STRINGIMAGE i,STRINGIMAGE j) - [['bcStrings,[6, "0.0", hnam, 'F]]] - prefix := ('"\newline ") - labelList := [['text,:prefix],:labelList] - hList := [['text,:middle],:hList] - equationPart := [ - '(domainConditions - (isDomain EM $EmptyMode) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain I (Integer))), - :xpList,:cList,:ylList,:yrList,:hList] - page := htInitPage('"D02KEF - 2nd order Sturm-Liouville problem, regular/singular system, finite/infinite range, eigenvalue and eigenfunction, user-specified break-points", nil) - htSay '"\menuitemstyle{}\tab{2} Enter points where boundary " - htSay '"conditions are to be imposed {\it xpoint}: \newline " - htMakePage equationPart - htMakeDoneButton('"Continue",'d02kefGen) - htpSetProperty(page,'m,m) - htpSetProperty(page,'match,match) - htpSetProperty(page,'k,k) - htpSetProperty(page,'tol,tol) - htpSetProperty(page,'elam,elam) - htpSetProperty(page,'delam,delam) - htpSetProperty(page,'maxit,maxit) - htpSetProperty(page,'maxfun,maxfun) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -d02kefDefaultSolve(htPage,match,k,tol,elam,delam,maxit,maxfun,ifail) == - m := '5 - page := htInitPage('"D02KEF - 2nd order Sturm-Liouville problem, regular/singular system, finite/infinite range, eigenvalue and eigenfunction, user-specified break-points", nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter points where boundary conditions are to be imposed ") - (text . "{\it xpoint}: \newline ") - (bcStrings (10 "0.0" xp1 F)) - (bcStrings (10 "0.1" xp2 F)) - (bcStrings (10 "4**(1/3)" xp3 F)) - (bcStrings (10 "30.0" xp4 F)) - (bcStrings (10 "30.0" xp5 F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Value of {\it p} for COEFFN: \newline ") - (bcStrings (42 "1.0" c1 EM)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Value of {\it q} for COEFFN: \newline ") - (bcStrings (42 "ELAM-X-2.0/(X*X)" c2 EM)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Value of {\it dqdl} for COEFFN: \newline ") - (bcStrings (42 "1.0" c3 EM)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Values of YL(1) & YL(2) for BDYVAL: \newline ") - (bcStrings (42 "XL" yl1 EM)) - (bcStrings (42 "2.0" yl2 EM)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Values of YR(1) & YR(2) for BDYVAL: \newline ") - (bcStrings (42 "1.0" yr1 EM)) - (bcStrings (42 "-sqrt(XR-ELAM)" yr2 EM)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Maximum step size {\it hmax(2,m)}: \newline ") - (bcStrings (6 "0.0" h11 F)) - (bcStrings (6 "0.0" h12 F)) - (bcStrings (6 "0.0" h13 F)) - (bcStrings (6 "0.0" h14 F)) - (bcStrings (6 "0.0" h15 F)) - (text . "\newline ") - (bcStrings (6 "0.0" h21 F)) - (bcStrings (6 "0.0" h22 F)) - (bcStrings (6 "0.0" h23 F)) - (bcStrings (6 "0.0" h24 F)) - (bcStrings (6 "0.0" h25 F))) - htpSetProperty(page,'m,m) - htpSetProperty(page,'match,match) - htpSetProperty(page,'k,k) - htpSetProperty(page,'tol,tol) - htpSetProperty(page,'elam,elam) - htpSetProperty(page,'delam,delam) - htpSetProperty(page,'maxit,maxit) - htpSetProperty(page,'maxfun,maxfun) - htpSetProperty(page,'ifail,ifail) - htMakeDoneButton('"Continue",'d02kefGen) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -d02kefGen htPage == - m := htpProperty(htPage, 'm) - match := htpProperty(htPage, 'match) - k := htpProperty(htPage, 'k) - tol := htpProperty(htPage, 'tol) - elam := htpProperty(htPage, 'elam) - delam := htpProperty(htPage, 'delam) - maxit := htpProperty(htPage, 'maxit) - maxfun := htpProperty(htPage, 'maxfun) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - for i in 1..m repeat - for j in 1..2 repeat - h := STRCONC((first y).1," ") - rowList := [h,:rowList] - y := rest y - hList := [:hList,rowList] - rowList := [] - hList := reverse hList - hstring := bcwords2liststring [bcwords2liststring x for x in hList] - for i in 1..2 repeat - for j in 1..2 repeat - b := STRCONC((first y).1," ") - rowList := [b,:rowList] - y := rest y - bList := [:bList,rowList] - rowList := [] - bList := reverse bList - bstring := bcwords2liststring [bcwords2liststring x for x in bList] - for i in 1..3 repeat - c := STRCONC((first y).1," ") - cList := [c,:cList] - y := rest y - cstring := bcwords2liststring cList - while y repeat - x := STRCONC((first y).1," ") - xList := [x,:xList] - y := rest y - xstring := bcwords2liststring xList - prefix := STRCONC("d02kef([",xstring,"]::Matrix DoubleFloat, ",STRINGIMAGE m) - prefix := STRCONC(prefix,", ",STRINGIMAGE k,", ",tol,", ",STRINGIMAGE maxfun) - prefix := STRCONC(prefix,", ",STRINGIMAGE match,", ",STRINGIMAGE elam,", ") - prefix:=STRCONC(prefix,STRINGIMAGE delam,", ",hstring,", ",STRINGIMAGE maxit) - end := STRCONC(", ",STRINGIMAGE ifail,",(",cstring,"::Vector(Expression Float))::ASP10(COEFFN)") - end := STRCONC(end,", (",bstring,"::Matrix Expression Float)::ASP80('BDYVAL))") - linkGen STRCONC (prefix,end) - -d02raf() == - htInitPage('"D02RAF - ODEs, general nonlinear boundary value problem, finite difference technique with deferred correction, continuation facility",nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXd02raf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d02raf| '|NagOrdinaryDifferentialEquationsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "D02RAF solves a two-point boundary value problem for a system ") - (text . "of {\it n} first-order ordinary differential equations ") - (text . "{\it \htbitmap{yi}'= \htbitmap{fi}(x,y)}, for {\it i} = 1,2,...,") - (text . "{\it n}, on the range [a,b] with {\it n} nonlinear boundary ") - (text . "conditions \htbitmap{gi}{\it (y(a),y(b)) = 0} for {\it i} = 1,2,") - (text . "...,{\it n} using a deferred correction technique and a Newton ") - (text . "iteration; the solution is computed on a mesh. A continuation ") - (text . "facility is provided for which a family of problems is solved ") - (text . "posed as {\it y' = f(x,y,\epsilon)} subject to the boundary ") - (text . "conditions {\it g(y(a),y(b),\epsilon) = 0}, where \epsilon ") - (text . "is the continuation parameter. The choice \epsilon = 0 should ") - (text . "define an easy problem to solve and \epsilon = 1 the problem ") - (text . "whose solution is required; a sequence of problems is solved ") - (text . "with 0 = \htbitmap{ep1} < \htbitmap{ep2} < ... \htbitmap{epp} ") - (text . "= 1 where {\it p} and the \htbitmap{epi} are chosen by D02RAF. ") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the number of differential equations {\it n}: ") - (text . "\newline\tab{2} ") - (bcStrings (5 3 n PI)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "The maximum number of points in the mesh {\it mnp}: ") - (text . "\newline\tab{2} ") - (bcStrings (5 40 mnp PI)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Number of points in the initial mesh {\it np}:") - (text . "\newline\tab{2} ") - (bcStrings (5 17 np PI)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") - (text . "\newline Number of boundary conditions involving y(a) only ") - (text . "{\it numbeg}: \newline\tab{2} ") - (bcStrings (5 2 numbeg PI)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "\newline Boundary conditions involving both y(a) and ") - (text . "y(b) {\it nummix}: \newline\tab{2} ") - (text . "\newline\tab{2} ") - (bcStrings (5 0 nummix PI)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Absolute error tolerance {\it tol}: ") - (text . "\newline\tab{2} ") - (bcStrings (10 "1.0e-4" tol F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Do you wish to use an intial mesh or default values,{\it init} ") - (radioButtons init - ("" " default values" init_zero) - ("" " initial mesh" init_nonZero)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "First dimension of y, {\it iy}: ") - (text . "\newline\tab{2} ") - (bcStrings (5 3 iy PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Are JACOBF & JACOBG routines being supplied, {\it ijac}:") - (radioButtons ijac - ("" " yes" ijac_nonZero) - ("" " no" ijac_zero)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Continuation facility {\it deleps}:") - (text . "\newline\tab{2} ") - (bcStrings (5 "0.1" deleps F)) - (text . "\newline\tab{2} ") - (text . "Note: For 0.0 \htbitmap{great=} deleps > 1.0, continuation ") - (text . "is not used. ") - (text . "\blankline ") - (text . "\newline \tab{2} ") - (text . "Ifail is input in three components: ") - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "{\it a} ") - (radioButtons afail - ("" " 0, hard failure" azero) - ("" " 1, soft failure" aone)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "{\it b} ") - (radioButtons bfail - ("" " 1, print error messages" bone) - ("" " 0, suppress error messages" bzero)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "{\it c} ") - (radioButtons cfail - ("" " 1, print warning messages" cone) - ("" " 0, suppress warning messages" czero))) - htMakeDoneButton('"Continue", 'd02rafSolve) - htShowPage() - -d02rafSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - mnp := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'mnp) - objValUnwrap htpLabelSpadValue(htPage, 'mnp) - np := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'np) - objValUnwrap htpLabelSpadValue(htPage, 'np) - numbeg := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'numbeg) - objValUnwrap htpLabelSpadValue(htPage, 'numbeg) - nummix := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nummix) - objValUnwrap htpLabelSpadValue(htPage, 'nummix) - tol := htpLabelInputString(htPage,'tol) - mesh := htpButtonValue(htPage,'init) - init := - mesh = 'init_zero => '0 - '1 - iy := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iy) - objValUnwrap htpLabelSpadValue(htPage, 'iy) - jacob := htpButtonValue(htPage,'ijac) - ijac := - jacob = 'ijac_zero => '0 - '1 - deleps := htpLabelInputString(htPage,'deleps) - lwork := mnp*(3*n*n + 6*n +2) +4*n*n + 3*n - liwork := - ijac = 0 => mnp*(2*n +1) + n*n + 4*n +2 - mnp*(2*n +1) + n - aerror := htpButtonValue(htPage,'afail) - afail := - aerror = 'azero => '0 - '1 - berror := htpButtonValue(htPage,'bfail) - bfail := - berror = 'bone => '1 - '0 - cerror := htpButtonValue(htPage,'cfail) - cfail := - cerror = 'cone => '1 - '0 - ifail := 100*cfail + 10*bfail + afail - (n = '3 and init = '0 and iy = '3 and nummix = '0 and numbeg = '2 and np = '17 and mnp = '40) => d02rafDefaultSolve(htPage,mnp,np,numbeg,nummix,tol,init,iy,ijac,deleps,lwork,liwork,ifail) - init = '1 => d02rafCopOut() - funcList := - "append"/[fa(i) for i in 1..n] where fa(i) == - prefix := ('"\newline {\em Function f") - prefix := STRCONC(prefix,STRINGIMAGE i,'":} \space{1}") - funct := STRCONC ('"Y[",STRINGIMAGE i ,"]") - fnam := INTERN STRCONC ('"f",STRINGIMAGE i) - [['text,:prefix],['bcStrings,[42, funct, fnam, 'EM]]] - middle := ('"\blankline \menuitemstyle{} \tab{2} Enter the functions ") - middle := STRCONC(middle,'"\htbitmap{gi} below ") - middle := STRCONC(middle,'"as functions of YA[i] and YB[i]: \newline ") - gList := - "append"/[fb(i) for i in 1..n] where fb(i) == - prefix := ('"\newline {\em Function g") - prefix := STRCONC(prefix,STRINGIMAGE i,'":} \space{1}") - fnc := STRCONC ('"YA[",STRINGIMAGE i ,"]") - gnam := INTERN STRCONC ('"g",STRINGIMAGE i) - [['text,:prefix],['bcStrings,[42, fnc, gnam, 'EM]]] - gList := [['text,:middle],:gList] - mid:= ('"\blankline \menuitemstyle{} \tab{2} Enter the array ") - mid := STRCONC(mid,'"{\it x(mnp)}: \newline ") - xList := - "append"/[fc(i) for i in 1..mnp] where fc(i) == - xnam := INTERN STRCONC ('"x",STRINGIMAGE i) - [['bcStrings,[4, 0, xnam, 'F]]] - xList := [['text,:mid],:xList] - equationPart := [ - '(domainConditions - (isDomain EM $EmptyMode) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain I (Integer))), - :funcList,:gList,:xList] - page := htInitPage('"D02RAF - ODEs, general nonlinear boundary value problem, finite difference technique with deferred correction, continuation facility",nil) - htSay '"\menuitemstyle{}\tab{2} " - htSay '"Enter the functions \htbitmap{fi} (i.e. the derivatives) below " - htSay '"as functions of Y[1]...Y[n]: " - htSay '"\newline " - htMakePage equationPart - htMakeDoneButton('"Continue",'d02rafGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'mnp,mnp) - htpSetProperty(page,'np,np) - htpSetProperty(page,'numbeg,numbeg) - htpSetProperty(page,'nummix,nummix) - htpSetProperty(page,'tol,tol) - htpSetProperty(page,'init,init) - htpSetProperty(page,'iy,iy) - htpSetProperty(page,'ijac,ijac) - htpSetProperty(page,'deleps,deleps) - htpSetProperty(page,'lwork,lwork) - htpSetProperty(page,'liwork,liwork) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -d02rafDefaultSolve(htPage,mnp,np,numbeg,nummix,tol,init,iy,ijac,deleps,lwork,liwork,ifail) == - n := '3 - page := htInitPage('"D02RAF - ODEs, general nonlinear boundary value problem, finite difference technique with deferred correction, continuation facility",nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the functions \htbitmap{fi} (i.e. the derivatives) below ") - (text . "as functions of Y[1]...Y[n]: ") - (text . "\newline {\em Function f1:} \space{1}") - (bcStrings (44 "Y[2]" f1 EM)) - (text . "\newline {\em Function f2:} \space{1}") - (bcStrings (44 "Y[3]" f2 EM)) - (text . "\newline {\em Function f3:} \space{1}") - (bcStrings (44 "-Y[1]*Y[3] - 2*EPS*(1-Y[2]*Y[2])" f3 EM)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the functions \htbitmap{gi} below ") - (text . "as functions of YA[i] and YB[i]: ") - (text . "\newline {\em Function g1:} \space{1}") - (bcStrings (44 "YA[1]" g1 EM)) - (text . "\newline {\em Function g2:} \space{1}") - (bcStrings (44 "YA[2]" g2 EM)) - (text . "\newline {\em Function g3:} \space{1}") - (bcStrings (44 "YB[2] -1" g3 EM)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the array {\it x(mnp)}: \newline ") - (bcStrings (4 "0.0" x1 F)) - (bcStrings (4 "0.0" x2 F)) - (bcStrings (4 "0.0" x3 F)) - (bcStrings (4 "0.0" x4 F)) - (bcStrings (4 "0.0" x5 F)) - (bcStrings (4 "0.0" x6 F)) - (bcStrings (4 "0.0" x7 F)) - (bcStrings (4 "0.0" x8 F)) - (bcStrings (4 "0.0" x9 F)) - (bcStrings (4 "0.0" x10 F)) - (bcStrings (4 "0.0" x11 F)) - (bcStrings (4 "0.0" x12 F)) - (bcStrings (4 "0.0" x13 F)) - (bcStrings (4 "0.0" x14 F)) - (bcStrings (4 "0.0" x15 F)) - (bcStrings (4 "0.0" x16 F)) - (bcStrings (4 "10.0" x17 F)) - (bcStrings (4 "0.0" x18 F)) - (bcStrings (4 "0.0" x19 F)) - (bcStrings (4 "0.0" x20 F)) - (bcStrings (4 "0.0" x21 F)) - (bcStrings (4 "0.0" x22 F)) - (bcStrings (4 "0.0" x23 F)) - (bcStrings (4 "0.0" x24 F)) - (bcStrings (4 "0.0" x25 F)) - (bcStrings (4 "0.0" x26 F)) - (bcStrings (4 "0.0" x27 F)) - (bcStrings (4 "0.0" x28 F)) - (bcStrings (4 "0.0" x29 F)) - (bcStrings (4 "0.0" x30 F)) - (bcStrings (4 "0.0" x31 F)) - (bcStrings (4 "0.0" x32 F)) - (bcStrings (4 "0.0" x33 F)) - (bcStrings (4 "0.0" x34 F)) - (bcStrings (4 "0.0" x35 F)) - (bcStrings (4 "0.0" x36 F)) - (bcStrings (4 "0.0" x37 F)) - (bcStrings (4 "0.0" x38 F)) - (bcStrings (4 "0.0" x39 F)) - (bcStrings (4 "0.0" x40 F))) - htpSetProperty(page,'n,n) - htpSetProperty(page,'mnp,mnp) - htpSetProperty(page,'np,np) - htpSetProperty(page,'numbeg,numbeg) - htpSetProperty(page,'nummix,nummix) - htpSetProperty(page,'tol,tol) - htpSetProperty(page,'init,init) - htpSetProperty(page,'iy,iy) - htpSetProperty(page,'ijac,ijac) - htpSetProperty(page,'deleps,deleps) - htpSetProperty(page,'lwork,lwork) - htpSetProperty(page,'liwork,liwork) - htpSetProperty(page,'ifail,ifail) - htMakeDoneButton('"Continue",'d02rafGen) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -d02rafGen htPage == - n := htpProperty(htPage, 'n) - mnp := htpProperty(htPage, 'mnp) - np := htpProperty(htPage, 'np) - numbeg := htpProperty(htPage, 'numbeg) - nummix := htpProperty(htPage, 'nummix) - tol := htpProperty(htPage, 'tol) - init := htpProperty(htPage, 'init) - iy := htpProperty(htPage, 'iy) - ijac := htpProperty(htPage, 'ijac) - deleps := htpProperty(htPage, 'deleps) - lwork := htpProperty(htPage, 'lwork) - liwork := htpProperty(htPage, 'liwork) - ifail := htpProperty(htPage, 'ifail) - alist := htpInputAreaAlist htPage - y := alist - for i in 1..mnp repeat - xtemp := STRCONC((first y).1," ") - xList := [xtemp,:xList] - y := rest y - xstring := bcwords2liststring xList - for i in 1..n repeat - gtemp := STRCONC((first y).1," ") - gList := [gtemp,:gList] - y := rest y - gstring := bcwords2liststring gList - while y repeat - f := STRCONC((first y).1," ") - fList := [f,:fList] - y := rest y - fstring := bcwords2liststring fList - prefix := STRCONC("d02raf(",STRINGIMAGE n,", ",STRINGIMAGE mnp,", ") - prefix := STRCONC(prefix,STRINGIMAGE numbeg,", ",STRINGIMAGE nummix,", ") - prefix := STRCONC(prefix,tol,", ",STRINGIMAGE init,", ",STRINGIMAGE iy,", ") - middle:= STRCONC(STRINGIMAGE ijac,", ",STRINGIMAGE lwork,", ") - middle := STRCONC(middle,STRINGIMAGE liwork,", ",STRINGIMAGE np,", [") - middle := STRCONC(middle,xstring,"],[[0.0 for i in 1..", STRINGIMAGE mnp) - middle := STRCONC(middle,"] for j in 1..",STRINGIMAGE iy,"]") - middle := STRCONC(middle,":: Matrix DoubleFloat,",STRINGIMAGE deleps,", ") - middle := STRCONC(middle,STRINGIMAGE ifail,", (",fstring,"::Vector ") - middle := STRCONC(middle,"Expression Float)::ASP41('FCN,'JACOBF,'JACEPS),(") - middle := STRCONC(middle,gstring,"::Vector Expression Float)::ASP42('G,'JACOBG,") - middle := STRCONC(middle,"'JACGEP))") - linkGen STRCONC(prefix,middle) - - -d02rafCopOut() == - htInitPage('"D02RAF - ODEs, general nonlinear boundary value problem, finite difference technique with deferred correction, continuation facility",nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\blankline ") - (text . "{\center{\em Hyperdoc interface not available for initial mesh}}") - (text . "\newline ") - (text . "{\center{\em Please use the command line.}}")) - htMakeDoneButton('"Continue",'d02raf) - htShowPage() -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/nag-d03.boot b/src/interp/nag-d03.boot new file mode 100644 index 00000000..912d8cea --- /dev/null +++ b/src/interp/nag-d03.boot @@ -0,0 +1,641 @@ +-- 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. + + +)package "BOOT" + +d03edf() == + htInitPage('"D03EDF - Elliptic PDE, solution of finite difference equations by a multigrid technique ",nil) + htMakePage '( + (domainConditions + (isDomain EM $EmptyMode) + (isDomain F (Float))) + (text . "\windowlink{Manual Page}{manpageXXd03edf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d03edf| '|NagPartialDifferentialEquationsPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\newline ") + (text . "D03EDF solves, by multigrid iteration, the seven point scheme ") + (text . "\newline \htbitmap{d03edf} \newline which arises from the ") + (text . "discretization of an elliptic partial differential equation of ") + (text . "the form \center{\htbitmap{d03edf1}} and its boundary conditions") + (text . ", defined on a rectangular region. This we can write in matrix ") + (text . "form as \newline \center{{\it Au =f}}") + (text . "\blankline") + (text . "\newline ") + (text . "Read the input file to see the example program. ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "\spadcommand{)read d03edf \bound{s0}} ") + (text . "\blankline") + (text . "\newline ") + (text . "If you would like to enter a problem, ") + (text . "how would you like to input the matrices? ") + (radioButtons matrix + ("" " By entering individual entries" long) + ("" " By entering matrix names already defined on the command line" short))) + htMakeDoneButton('"Continue", 'd03edfControl) + htShowPage() + +d03edfControl(htPage) == + type := htpButtonValue(htPage,'matrix) + if (type = 'long) then + d03edfLong() + else + d03edfShort() + +d03edfLong() == + htInitPage('"D03EDF - Elliptic PDE, solution of finite difference equations by a multigrid technique ",nil) + htMakePage '( + (domainConditions + (isDomain EM $EmptyMode) + (isDomain F (Float))) + (text . "\blankline") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Number of interior grid points in the {\it x}-direction ") + (text . "{\it ngx}: ") + (text . "\newline\tab{2} ") + (bcStrings (10 3 ngx PI)) + (text . "\blankline") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Number of interior grid points in the {\it y}-direction ") + (text . "{\it ngy}: ") + (text . "\newline\tab{2} ") + (bcStrings (10 3 ngy PI)) + (text . "\blankline") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "First dimension of A, {\it lda}: ") + (text . "\newline\tab{2} ") + (bcStrings (10 22 lda PI)) + (text . "\blankline") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Maximum permitted number of multigrid iterations, {\it maxit}: ") + (text . "\newline\tab{2} ") + (bcStrings (10 1 maxit PI)) + (text . "\blankline") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Tolerance required, {\it acc}: ") + (text . "\newline\tab{2} ") + (bcStrings (10 "1.0e-4" acc F)) + (text . "\blankline") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "\newline Output of printed information for routine {\it iout}:") + (radioButtons iout + ("" " 0 - no output" zero) + ("" " 1 - the solution \htbitmap{uij} {\it i} = 1,2,...,NGX; {\it j} = 1,2,...,NGY" one) + ("" " 2 - residual 2-norm after each iteration " two) + ("" " 3 - as for iout = 1 & iout = 2" three) + ("" " 4 - as for iout = 3, plus the final residual" four) + ("" " 5 - as for iout = 4, plus initial elements of A & RHS" five) + ("" " 6 - as for iout = 5, plus Galerkin coarse grid approximations" six) + ("" " 7 - as for iout = 6, plus the incomplete Crout decompositions" seven) + ("" " 8 - as for iout = 7, plus the residual after each iteration" eight)) + (text . "\blankline") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "\newline Ifail value:") + (radioButtons ifail + ("" " -1, Print error messages" ifail_minusOne) + ("" " 1, Suppress error messages" ifail_one))) + htMakeDoneButton('"Continue", 'd03edfSolve) + htShowPage() + + +d03edfSolve htPage == + ngx := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ngx) + objValUnwrap htpLabelSpadValue(htPage, 'ngx) + ngy := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ngy) + objValUnwrap htpLabelSpadValue(htPage, 'ngy) + lda := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lda) + objValUnwrap htpLabelSpadValue(htPage, 'lda) + maxit := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'maxit) + objValUnwrap htpLabelSpadValue(htPage, 'maxit) + acc := htpLabelInputString(htPage,'acc) + control := htpButtonValue(htPage,'iout) + iout := + control = 'zero => '0 + control = 'one => '1 + control = 'two => '2 + control = 'three => '3 + control = 'four => '4 + control = 'five => '5 + control = 'six => '6 + control = 'seven => '7 + '8 + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'ifail_one => '1 + '-1 + aList := + "append"/[fa(i) for i in 1..lda] where fa(i) == + labelList := + "append"/[fb(i,j) for j in 1..7] where fb(i,j) == + anam := INTERN STRCONC ('"a",STRINGIMAGE i,STRINGIMAGE j) + [['bcStrings,[5, 0, anam, 'F]]] + prefix := ('"\newline ") + labelList := [['text,:prefix],:labelList] + middle := ('"\blankline \menuitemstyle{} \tab{2} Enter the matrix ") + middle := STRCONC(middle,'"{\it rhs(lda)}: \newline ") + rList := + "append"/[fc(i) for i in 1..lda] where fc(i) == + rnam := INTERN STRCONC ('"r",STRINGIMAGE i) + [['bcStrings,[6, "0.0", rnam, 'F]]] + rList := [['text,:middle],:rList] + mid:= ('"\blankline \menuitemstyle{} \tab{2} Enter the matrix ") + mid := STRCONC(mid,'" {\it ub(ngx*ngy)}: \newline ") + uList := + "append"/[fd(i) for i in 1..(ngx*ngy)] where fd(i) == + unam := INTERN STRCONC ('"u",STRINGIMAGE i) + [['bcStrings,[6, 0, unam, 'F]]] + uList := [['text,:mid],:uList] + equationPart := [ + '(domainConditions + (isDomain EM $EmptyMode) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain I (Integer))), + :aList,:rList,:uList] + page := htInitPage('"D03EDF - Elliptic PDE, solution of finite difference equations by a multigrid technique ",nil) + htSay '"\menuitemstyle{}\tab{2} " + htSay '"Enter the matrix {\it a(lda,7)}: " + htSay '"\newline " + htMakePage equationPart + htMakeDoneButton('"Continue",'d03edfLongGen) + htpSetProperty(page,'ngx,ngx) + htpSetProperty(page,'ngy,ngy) + htpSetProperty(page,'lda,lda) + htpSetProperty(page,'maxit,maxit) + htpSetProperty(page,'acc,acc) + htpSetProperty(page,'iout,iout) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +d03edfLongGen htPage == + ngx := htpProperty(htPage, 'ngx) + ngy := htpProperty(htPage, 'ngy) + lda := htpProperty(htPage, 'lda) + maxit := htpProperty(htPage, 'maxit) + acc := htpProperty(htPage, 'acc) + iout := htpProperty(htPage, 'iout) + ifail := htpProperty(htPage, 'ifail) + alist := htpInputAreaAlist htPage + y := alist + for i in 1..(ngx*ngy) repeat + utemp := STRCONC((first y).1," ") + uList := [utemp,:uList] + y := rest y + ustring := bcwords2liststring uList + for i in 1..lda repeat + rtemp := STRCONC((first y).1," ") + rList := [rtemp,:rList] + y := rest y + rstring := bcwords2liststring rList + for i in 1..lda repeat + for j in 1..7 repeat + v := STRCONC((first y).1," ") + rowList := [v,:rowList] + y := rest y + vList := [:vList,rowList] + rowList := [] + vList := reverse vList + astring := bcwords2liststring [bcwords2liststring x for x in vList] + prefix := STRCONC("d03edf(", STRINGIMAGE ngx,", ",STRINGIMAGE ngy,", ") + prefix := STRCONC(prefix,STRINGIMAGE lda,", ",STRINGIMAGE maxit,", ",acc) + mid := STRCONC(", ",STRINGIMAGE iout,", ",astring,"::Matrix DoubleFloat,[") + mid := STRCONC(mid,rstring,"],[",ustring,"],",STRINGIMAGE ifail,")") + linkGen STRCONC(prefix,mid) + +d03edfShort() == + htInitPage('"D03EDF - Elliptic PDE, solution of finite difference equations by a multigrid technique ",nil) + htMakePage '( + (domainConditions + (isDomain EM $EmptyMode) + (isDomain F (Float))) + (text . "\blankline") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Number of interior grid points in the {\it x}-direction ") + (text . "\htbitmap{nx}: ") + (text . "\newline\tab{2} ") + (bcStrings (10 0 ngx PI)) + (text . "\blankline") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Number of interior grid points in the {\it y}-direction ") + (text . "\htbitmap{ny}: ") + (text . "\newline\tab{2} ") + (bcStrings (10 0 ngy PI)) + (text . "\blankline") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "First dimension of A, {\it lda}: ") + (text . "\newline\tab{2} ") + (bcStrings (10 0 lda PI)) + (text . "\blankline") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Name of the array {\it a(lda,7)} defined on the command line: ") + (text . "\newline\tab{2} ") + (bcStrings (10 "a" a EM)) + (text . "\blankline") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Name of the array {\it rhs(lda)} defined on the command line: ") + (text . "\newline\tab{2} ") + (bcStrings (10 "rhs" rhs EM)) + (text . "\blankline") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Name of the array {\it ub(ngx*ngy)} defined on the command line:") + (text . "\newline\tab{2} ") + (bcStrings (10 "ub" ub EM)) + (text . "\blankline") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Maximum permitted number of multigrid iterations, {\it maxit}: ") + (text . "\newline\tab{2} ") + (bcStrings (10 0 maxit PI)) + (text . "\blankline") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Tolerance required, {\it acc}: ") + (text . "\newline\tab{2} ") + (bcStrings (10 "1.0e-4" acc F)) + (text . "\blankline") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "\newline Output of printed information for routine {\it iout}:") + (radioButtons iout + ("" " 0 - no output" zero) + ("" " 1 - the solution \htbitmap{uij} {\it i} = 1,2,...,NGX; {\it j} = 1,2,...,NGY" one) + ("" " 2 - residual 2-norm after each iteration " two) + ("" " 3 - as for iout = 1 & iout = 2" three) + ("" " 4 - as for iout = 3, plus the final residual" four) + ("" " 5 - as for iout = 4, plus initial elements of A & RHS" five) + ("" " 6 - as for iout = 5, plus Galerkin coarse grid approximations" six) + ("" " 7 - as for iout = 6, plus the incomplete Crout decompositions" seven) + ("" " 8 - as for iout = 7, plus the residual after each iteration" eight)) + (text . "\blankline") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "\newline Ifail value:") + (radioButtons ifail + ("" " -1, Print error messages" ifail_minusOne) + ("" " 1, Suppress error messages" ifail_one))) + htMakeDoneButton('"Continue", 'd03edfShortGen) + htShowPage() + + +d03edfShortGen htPage == + ngx := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ngx) + objValUnwrap htpLabelSpadValue(htPage, 'ngx) + ngy := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ngy) + objValUnwrap htpLabelSpadValue(htPage, 'ngy) + lda := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lda) + objValUnwrap htpLabelSpadValue(htPage, 'lda) + maxit := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'maxit) + objValUnwrap htpLabelSpadValue(htPage, 'maxit) + a := htpLabelInputString(htPage, 'a) + rhs := htpLabelInputString(htPage, 'rhs) + ub := htpLabelInputString(htPage, 'ub) + acc := htpLabelInputString(htPage,'acc) + control := htpButtonValue(htPage,'iout) + iout := + control = 'zero => '0 + control = 'one => '1 + control = 'two => '2 + control = 'three => '3 + control = 'four => '4 + control = 'five => '5 + control = 'six => '6 + control = 'seven => '7 + '8 + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'ifail_one => '1 + '-1 + prefix := STRCONC("d03edf(", STRINGIMAGE ngx,", ",STRINGIMAGE ngy,", ") + prefix := STRCONC(prefix,STRINGIMAGE lda,", ",STRINGIMAGE maxit,", ",acc) + mid := STRCONC(", ",STRINGIMAGE iout,", ",a,", ") + mid := STRCONC(mid,rhs,", ",ub,", ",STRINGIMAGE ifail,")") + linkGen STRCONC(prefix,mid) + + + +d03eef() == + htInitPage('"D03EEF - Discretize a 2nd order elliptic PDE on a rectangle",nil) + htMakePage '( + (domainConditions + (isDomain EM $EmptyMode) + (isDomain F (Float))) + (text . "\windowlink{Manual Page}{manpageXXd03eef} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d03eef| '|NagPartialDifferentialEquationsPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\newline ") + (text . "D03EEF discretizes a second order linear elliptic partial ") + (text . "differential equation of the form \center{\htbitmap{d03eef}} ") + (text . "on a rectangular region \newline \tab{2} ") + (text . "{\it x}a \htbitmap{less=} {\it x} \htbitmap{less=} {\it x}b ") + (text . "\newline \tab{2} {\it y}a \htbitmap{less=} {\it y} ") + (text . "\htbitmap{less=} {\it y}b \newline subject to the boundary ") + (text . "conditions of the form \newline \htbitmap{d03eef1} \newline ") + (text . "where {\it \delta U/ \delta n} denotes the outward pointing ") + (text . "normal derivative on the boundary. The equation is said to be ") + (text . "elliptic if \center{\htbitmap{d03eef2}} \newline for all points ") + (text . "in the rectangular region. The seven-diagonal linear equations ") + (text . "produced are in a form suitable for passing directly to the ") + (text . "multigrid routine D03EDF. \blankline ") + (text . "The equation is discretized on a rectangular grid, with ") + (text . "\htbitmap{nx} grid points in the {\it x}-direction and ") + (text . "\htbitmap{ny} grid points in the {\it y}-direction. ")) + htMakeDoneButton('"Continue", 'd03eefInput) + htShowPage() + +d03eefInput() == + htInitPage('"D03EEF - Discretize a 2nd order elliptic PDE on a rectangle",nil) + htMakePage '( + (domainConditions + (isDomain EM $EmptyMode) + (isDomain F (Float))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Enter the value {\it x}a, {\it xmin}: ") + (text . "\newline\tab{2} ") + (bcStrings (10 "0.0" xmin F)) + (text . "\blankline") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Enter the value {\it x}b, {\it xmax}: ") + (text . "\newline\tab{2} ") + (bcStrings (10 "1.0" xmax F)) + (text . "\blankline") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Enter the value {\it y}a, {\it ymin}: ") + (text . "\newline\tab{2} ") + (bcStrings (10 "0.0" ymin F)) + (text . "\blankline") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Enter the value {\it y}b, {\it ymax}: ") + (text . "\newline\tab{2} ") + (bcStrings (10 "1.0" ymax F)) + (text . "\blankline") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Number of interior grid points in the {\it x}-direction ") + (text . "{\it ngx}: ") + (text . "\newline\tab{2} ") + (bcStrings (10 9 ngx PI)) + (text . "\blankline") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Number of interior grid points in the {\it y}-direction ") + (text . "{\it ngy}: ") + (text . "\newline\tab{2} ") + (bcStrings (10 9 ngy PI)) + (text . "\blankline") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "First dimension of A, {\it lda}: ") + (text . "\newline\tab{2} ") + (bcStrings (10 133 lda PI)) + (text . "\blankline") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "\newline Which {\it scheme} would you like to use: ") + (radioButtons scheme + (" C" " central differences" cent) + (" U" " upwind differences" up)) + (text . "\blankline") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "\newline Ifail value:") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'd03eefSolve) + htShowPage() + + + +d03eefSolve htPage == + xmin := htpLabelInputString(htPage,'xmin) + xmax := htpLabelInputString(htPage,'xmax) + ymin := htpLabelInputString(htPage,'ymin) + ymax := htpLabelInputString(htPage,'ymax) + ngx := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ngx) + objValUnwrap htpLabelSpadValue(htPage, 'ngx) + ngy := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ngy) + objValUnwrap htpLabelSpadValue(htPage, 'ngy) + lda := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lda) + objValUnwrap htpLabelSpadValue(htPage, 'lda) + diff := htpButtonValue(htPage,'scheme) + scheme := + diff = 'cent => '"C" + '"U" + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + d03eefDefaultSolve(htPage,xmin,xmax,ymin,ymax,ngx,ngy,lda,scheme,ifail) + +d03eefDefaultSolve(htPage,xmin,xmax,ymin,ymax,ngx,ngy,lda,scheme,ifail) == + page := htInitPage('"D03EEF - Discretize a 2nd order elliptic PDE on a rectangle",nil) + htMakePage '( + (domainConditions + (isDomain EM $EmptyMode) + (isDomain F (Float))) + (text . "Please enter the values of \alpha to \psi to construct PDEF.") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "\alpha (x,y): \tab{10} ") + (bcStrings (46 1 alpha F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "\beta (x,y): \tab{10} ") + (bcStrings (46 0 beta F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "\gamma (x,y): \tab{10} ") + (bcStrings (46 1 gamma F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "\delta (x,y): \tab{10} ") + (bcStrings (46 50 delta F)) + (text . "\blankline") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "\epsilon (x,y): \tab{10} ") + (bcStrings (46 50 eps F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "\phi (x,y): \tab{10} ") + (bcStrings (46 0 phi F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "\psi (x,y): \tab{10} ") + (bcStrings (55 "-2*sin(X)*sin(Y) + 50*cos(X)*sin(Y) +50*sin(X)*cos(Y)" psi EM)) + (text . "\blankline ") + (text . "Please enter the boundary conditions a(x,y), b(x,y), and c(x,y) ") + (text . "for the top, bottom, left and right hand sides, to construct ") + (text . "BNDY. \blankline") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Bottom boundary conditions: ") + (text . "\newline a(x,y): \tab{10} ") + (bcStrings (46 0 a11 F)) + (text . "\newline b(x,y): \tab{10} ") + (bcStrings (46 1 a12 F)) + (text . "\newline c(x,y): \tab{10} ") + (bcStrings (46 "-sin(X)" a13 EM)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Right boundary conditions: ") + (text . "\newline a(x,y): \tab{10} ") + (bcStrings (46 1 a21 F)) + (text . "\newline b(x,y): \tab{10} ") + (bcStrings (46 0 a22 F)) + (text . "\newline c(x,y): \tab{10} ") + (bcStrings (46 "sin(X)*sin(Y)" a23 EM)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Top boundary conditions: ") + (text . "\newline a(x,y): \tab{10} ") + (bcStrings (46 1 a31 F)) + (text . "\newline b(x,y): \tab{10} ") + (bcStrings (46 0 a32 F)) + (text . "\newline c(x,y): \tab{10} ") + (bcStrings (46 "sin(X)*sin(Y)" a33 EM)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Left boundary conditions: ") + (text . "\newline a(x,y): \tab{10} ") + (bcStrings (46 0 a41 F)) + (text . "\newline b(x,y): \tab{10} ") + (bcStrings (46 1 a42 F)) + (text . "\newline c(x,y): \tab{10} ") + (bcStrings (46 "-sin(Y)" a43 EM))) + htMakeDoneButton('"Continue",'d03eefGen) + htpSetProperty(page,'xmin,xmin) + htpSetProperty(page,'xmax,xmax) + htpSetProperty(page,'ymin,ymin) + htpSetProperty(page,'ymax,ymax) + htpSetProperty(page,'ngx,ngx) + htpSetProperty(page,'ngy,ngy) + htpSetProperty(page,'lda,lda) + htpSetProperty(page,'scheme,scheme) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +d03eefGen htPage == + xmin := htpProperty(htPage, 'xmin) + xmax := htpProperty(htPage, 'xmax) + ymin := htpProperty(htPage, 'ymin) + ymax := htpProperty(htPage, 'ymax) + ngx := htpProperty(htPage, 'ngx) + ngy := htpProperty(htPage, 'ngy) + lda := htpProperty(htPage, 'lda) + scheme := htpProperty(htPage, 'scheme) + ifail := htpProperty(htPage, 'ifail) + alist := htpInputAreaAlist htPage + y := alist + for i in 1..4 repeat + for j in 1..3 repeat + v := STRCONC((first y).1," ") + rowList := [v,:rowList] + y := rest y + vList := [:vList,rowList] + rowList := [] + vList := reverse vList + astring := bcwords2liststring [bcwords2liststring x for x in vList] + for i in 1..7 repeat + utemp := STRCONC((first y).1," ") + uList := [utemp,:uList] + y := rest y + ustring := bcwords2liststring uList + prefix := STRCONC("d03eef(",xmin,", ",xmax,", ",ymin,", ",ymax,", ") + prefix := STRCONC(prefix,STRINGIMAGE ngx,", ",STRINGIMAGE ngy,", ") + prefix := STRCONC(prefix,STRINGIMAGE lda,",_"",scheme,"_", ") + prefix := STRCONC(prefix,STRINGIMAGE ifail,", (",ustring) + prefix := STRCONC(prefix,"::Vector Expression Float)::ASP73('PDEF),(") + prefix := STRCONC(prefix,astring,"::Matrix Expression Float)::ASP74('BNDY))") + linkGen prefix + +d03faf() == + htInitPage('"D03FAF - Elliptic PDE, Helmholtz equation, 3-D Cartesian co-ordinates",nil) + htMakePage '( + (domainConditions + (isDomain EM $EmptyMode) + (isDomain F (Float))) + (text . "\windowlink{Manual Page}{manpageXXd03faf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d03faf| '|NagPartialDifferentialEquationsPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\newline ") + (text . "D03FAF solves the three-dimensional Helmholtz equation ") + (text . "in cartesian co-ordinates: \center{\htbitmap{d03faf}} \newline ") + (text . "This subroutine forms the system of linear equations resulting ") + (text . "fom the standard seven-point finite difference equations, ") + (text . "and then solves the system using a method based on the fast ") + (text . "Fourier transform (FFT) described by Swartztrauber. ") + (text . "\blankline") + (text . "\newline ") + (text . "Read the input file to see the example program. ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "\spadcommand{)read d03faf \bound{s0}} ")) + htShowPage() diff --git a/src/interp/nag-d03.boot.pamphlet b/src/interp/nag-d03.boot.pamphlet deleted file mode 100644 index a59cf4c8..00000000 --- a/src/interp/nag-d03.boot.pamphlet +++ /dev/null @@ -1,663 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp nag-d03.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. - -@ -<<*>>= -<> - -)package "BOOT" - -d03edf() == - htInitPage('"D03EDF - Elliptic PDE, solution of finite difference equations by a multigrid technique ",nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXd03edf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d03edf| '|NagPartialDifferentialEquationsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "D03EDF solves, by multigrid iteration, the seven point scheme ") - (text . "\newline \htbitmap{d03edf} \newline which arises from the ") - (text . "discretization of an elliptic partial differential equation of ") - (text . "the form \center{\htbitmap{d03edf1}} and its boundary conditions") - (text . ", defined on a rectangular region. This we can write in matrix ") - (text . "form as \newline \center{{\it Au =f}}") - (text . "\blankline") - (text . "\newline ") - (text . "Read the input file to see the example program. ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "\spadcommand{)read d03edf \bound{s0}} ") - (text . "\blankline") - (text . "\newline ") - (text . "If you would like to enter a problem, ") - (text . "how would you like to input the matrices? ") - (radioButtons matrix - ("" " By entering individual entries" long) - ("" " By entering matrix names already defined on the command line" short))) - htMakeDoneButton('"Continue", 'd03edfControl) - htShowPage() - -d03edfControl(htPage) == - type := htpButtonValue(htPage,'matrix) - if (type = 'long) then - d03edfLong() - else - d03edfShort() - -d03edfLong() == - htInitPage('"D03EDF - Elliptic PDE, solution of finite difference equations by a multigrid technique ",nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain F (Float))) - (text . "\blankline") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Number of interior grid points in the {\it x}-direction ") - (text . "{\it ngx}: ") - (text . "\newline\tab{2} ") - (bcStrings (10 3 ngx PI)) - (text . "\blankline") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Number of interior grid points in the {\it y}-direction ") - (text . "{\it ngy}: ") - (text . "\newline\tab{2} ") - (bcStrings (10 3 ngy PI)) - (text . "\blankline") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "First dimension of A, {\it lda}: ") - (text . "\newline\tab{2} ") - (bcStrings (10 22 lda PI)) - (text . "\blankline") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Maximum permitted number of multigrid iterations, {\it maxit}: ") - (text . "\newline\tab{2} ") - (bcStrings (10 1 maxit PI)) - (text . "\blankline") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Tolerance required, {\it acc}: ") - (text . "\newline\tab{2} ") - (bcStrings (10 "1.0e-4" acc F)) - (text . "\blankline") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "\newline Output of printed information for routine {\it iout}:") - (radioButtons iout - ("" " 0 - no output" zero) - ("" " 1 - the solution \htbitmap{uij} {\it i} = 1,2,...,NGX; {\it j} = 1,2,...,NGY" one) - ("" " 2 - residual 2-norm after each iteration " two) - ("" " 3 - as for iout = 1 & iout = 2" three) - ("" " 4 - as for iout = 3, plus the final residual" four) - ("" " 5 - as for iout = 4, plus initial elements of A & RHS" five) - ("" " 6 - as for iout = 5, plus Galerkin coarse grid approximations" six) - ("" " 7 - as for iout = 6, plus the incomplete Crout decompositions" seven) - ("" " 8 - as for iout = 7, plus the residual after each iteration" eight)) - (text . "\blankline") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "\newline Ifail value:") - (radioButtons ifail - ("" " -1, Print error messages" ifail_minusOne) - ("" " 1, Suppress error messages" ifail_one))) - htMakeDoneButton('"Continue", 'd03edfSolve) - htShowPage() - - -d03edfSolve htPage == - ngx := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ngx) - objValUnwrap htpLabelSpadValue(htPage, 'ngx) - ngy := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ngy) - objValUnwrap htpLabelSpadValue(htPage, 'ngy) - lda := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lda) - objValUnwrap htpLabelSpadValue(htPage, 'lda) - maxit := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'maxit) - objValUnwrap htpLabelSpadValue(htPage, 'maxit) - acc := htpLabelInputString(htPage,'acc) - control := htpButtonValue(htPage,'iout) - iout := - control = 'zero => '0 - control = 'one => '1 - control = 'two => '2 - control = 'three => '3 - control = 'four => '4 - control = 'five => '5 - control = 'six => '6 - control = 'seven => '7 - '8 - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'ifail_one => '1 - '-1 - aList := - "append"/[fa(i) for i in 1..lda] where fa(i) == - labelList := - "append"/[fb(i,j) for j in 1..7] where fb(i,j) == - anam := INTERN STRCONC ('"a",STRINGIMAGE i,STRINGIMAGE j) - [['bcStrings,[5, 0, anam, 'F]]] - prefix := ('"\newline ") - labelList := [['text,:prefix],:labelList] - middle := ('"\blankline \menuitemstyle{} \tab{2} Enter the matrix ") - middle := STRCONC(middle,'"{\it rhs(lda)}: \newline ") - rList := - "append"/[fc(i) for i in 1..lda] where fc(i) == - rnam := INTERN STRCONC ('"r",STRINGIMAGE i) - [['bcStrings,[6, "0.0", rnam, 'F]]] - rList := [['text,:middle],:rList] - mid:= ('"\blankline \menuitemstyle{} \tab{2} Enter the matrix ") - mid := STRCONC(mid,'" {\it ub(ngx*ngy)}: \newline ") - uList := - "append"/[fd(i) for i in 1..(ngx*ngy)] where fd(i) == - unam := INTERN STRCONC ('"u",STRINGIMAGE i) - [['bcStrings,[6, 0, unam, 'F]]] - uList := [['text,:mid],:uList] - equationPart := [ - '(domainConditions - (isDomain EM $EmptyMode) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain I (Integer))), - :aList,:rList,:uList] - page := htInitPage('"D03EDF - Elliptic PDE, solution of finite difference equations by a multigrid technique ",nil) - htSay '"\menuitemstyle{}\tab{2} " - htSay '"Enter the matrix {\it a(lda,7)}: " - htSay '"\newline " - htMakePage equationPart - htMakeDoneButton('"Continue",'d03edfLongGen) - htpSetProperty(page,'ngx,ngx) - htpSetProperty(page,'ngy,ngy) - htpSetProperty(page,'lda,lda) - htpSetProperty(page,'maxit,maxit) - htpSetProperty(page,'acc,acc) - htpSetProperty(page,'iout,iout) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -d03edfLongGen htPage == - ngx := htpProperty(htPage, 'ngx) - ngy := htpProperty(htPage, 'ngy) - lda := htpProperty(htPage, 'lda) - maxit := htpProperty(htPage, 'maxit) - acc := htpProperty(htPage, 'acc) - iout := htpProperty(htPage, 'iout) - ifail := htpProperty(htPage, 'ifail) - alist := htpInputAreaAlist htPage - y := alist - for i in 1..(ngx*ngy) repeat - utemp := STRCONC((first y).1," ") - uList := [utemp,:uList] - y := rest y - ustring := bcwords2liststring uList - for i in 1..lda repeat - rtemp := STRCONC((first y).1," ") - rList := [rtemp,:rList] - y := rest y - rstring := bcwords2liststring rList - for i in 1..lda repeat - for j in 1..7 repeat - v := STRCONC((first y).1," ") - rowList := [v,:rowList] - y := rest y - vList := [:vList,rowList] - rowList := [] - vList := reverse vList - astring := bcwords2liststring [bcwords2liststring x for x in vList] - prefix := STRCONC("d03edf(", STRINGIMAGE ngx,", ",STRINGIMAGE ngy,", ") - prefix := STRCONC(prefix,STRINGIMAGE lda,", ",STRINGIMAGE maxit,", ",acc) - mid := STRCONC(", ",STRINGIMAGE iout,", ",astring,"::Matrix DoubleFloat,[") - mid := STRCONC(mid,rstring,"],[",ustring,"],",STRINGIMAGE ifail,")") - linkGen STRCONC(prefix,mid) - -d03edfShort() == - htInitPage('"D03EDF - Elliptic PDE, solution of finite difference equations by a multigrid technique ",nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain F (Float))) - (text . "\blankline") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Number of interior grid points in the {\it x}-direction ") - (text . "\htbitmap{nx}: ") - (text . "\newline\tab{2} ") - (bcStrings (10 0 ngx PI)) - (text . "\blankline") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Number of interior grid points in the {\it y}-direction ") - (text . "\htbitmap{ny}: ") - (text . "\newline\tab{2} ") - (bcStrings (10 0 ngy PI)) - (text . "\blankline") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "First dimension of A, {\it lda}: ") - (text . "\newline\tab{2} ") - (bcStrings (10 0 lda PI)) - (text . "\blankline") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Name of the array {\it a(lda,7)} defined on the command line: ") - (text . "\newline\tab{2} ") - (bcStrings (10 "a" a EM)) - (text . "\blankline") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Name of the array {\it rhs(lda)} defined on the command line: ") - (text . "\newline\tab{2} ") - (bcStrings (10 "rhs" rhs EM)) - (text . "\blankline") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Name of the array {\it ub(ngx*ngy)} defined on the command line:") - (text . "\newline\tab{2} ") - (bcStrings (10 "ub" ub EM)) - (text . "\blankline") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Maximum permitted number of multigrid iterations, {\it maxit}: ") - (text . "\newline\tab{2} ") - (bcStrings (10 0 maxit PI)) - (text . "\blankline") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Tolerance required, {\it acc}: ") - (text . "\newline\tab{2} ") - (bcStrings (10 "1.0e-4" acc F)) - (text . "\blankline") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "\newline Output of printed information for routine {\it iout}:") - (radioButtons iout - ("" " 0 - no output" zero) - ("" " 1 - the solution \htbitmap{uij} {\it i} = 1,2,...,NGX; {\it j} = 1,2,...,NGY" one) - ("" " 2 - residual 2-norm after each iteration " two) - ("" " 3 - as for iout = 1 & iout = 2" three) - ("" " 4 - as for iout = 3, plus the final residual" four) - ("" " 5 - as for iout = 4, plus initial elements of A & RHS" five) - ("" " 6 - as for iout = 5, plus Galerkin coarse grid approximations" six) - ("" " 7 - as for iout = 6, plus the incomplete Crout decompositions" seven) - ("" " 8 - as for iout = 7, plus the residual after each iteration" eight)) - (text . "\blankline") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "\newline Ifail value:") - (radioButtons ifail - ("" " -1, Print error messages" ifail_minusOne) - ("" " 1, Suppress error messages" ifail_one))) - htMakeDoneButton('"Continue", 'd03edfShortGen) - htShowPage() - - -d03edfShortGen htPage == - ngx := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ngx) - objValUnwrap htpLabelSpadValue(htPage, 'ngx) - ngy := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ngy) - objValUnwrap htpLabelSpadValue(htPage, 'ngy) - lda := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lda) - objValUnwrap htpLabelSpadValue(htPage, 'lda) - maxit := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'maxit) - objValUnwrap htpLabelSpadValue(htPage, 'maxit) - a := htpLabelInputString(htPage, 'a) - rhs := htpLabelInputString(htPage, 'rhs) - ub := htpLabelInputString(htPage, 'ub) - acc := htpLabelInputString(htPage,'acc) - control := htpButtonValue(htPage,'iout) - iout := - control = 'zero => '0 - control = 'one => '1 - control = 'two => '2 - control = 'three => '3 - control = 'four => '4 - control = 'five => '5 - control = 'six => '6 - control = 'seven => '7 - '8 - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'ifail_one => '1 - '-1 - prefix := STRCONC("d03edf(", STRINGIMAGE ngx,", ",STRINGIMAGE ngy,", ") - prefix := STRCONC(prefix,STRINGIMAGE lda,", ",STRINGIMAGE maxit,", ",acc) - mid := STRCONC(", ",STRINGIMAGE iout,", ",a,", ") - mid := STRCONC(mid,rhs,", ",ub,", ",STRINGIMAGE ifail,")") - linkGen STRCONC(prefix,mid) - - - -d03eef() == - htInitPage('"D03EEF - Discretize a 2nd order elliptic PDE on a rectangle",nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXd03eef} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d03eef| '|NagPartialDifferentialEquationsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "D03EEF discretizes a second order linear elliptic partial ") - (text . "differential equation of the form \center{\htbitmap{d03eef}} ") - (text . "on a rectangular region \newline \tab{2} ") - (text . "{\it x}a \htbitmap{less=} {\it x} \htbitmap{less=} {\it x}b ") - (text . "\newline \tab{2} {\it y}a \htbitmap{less=} {\it y} ") - (text . "\htbitmap{less=} {\it y}b \newline subject to the boundary ") - (text . "conditions of the form \newline \htbitmap{d03eef1} \newline ") - (text . "where {\it \delta U/ \delta n} denotes the outward pointing ") - (text . "normal derivative on the boundary. The equation is said to be ") - (text . "elliptic if \center{\htbitmap{d03eef2}} \newline for all points ") - (text . "in the rectangular region. The seven-diagonal linear equations ") - (text . "produced are in a form suitable for passing directly to the ") - (text . "multigrid routine D03EDF. \blankline ") - (text . "The equation is discretized on a rectangular grid, with ") - (text . "\htbitmap{nx} grid points in the {\it x}-direction and ") - (text . "\htbitmap{ny} grid points in the {\it y}-direction. ")) - htMakeDoneButton('"Continue", 'd03eefInput) - htShowPage() - -d03eefInput() == - htInitPage('"D03EEF - Discretize a 2nd order elliptic PDE on a rectangle",nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain F (Float))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Enter the value {\it x}a, {\it xmin}: ") - (text . "\newline\tab{2} ") - (bcStrings (10 "0.0" xmin F)) - (text . "\blankline") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Enter the value {\it x}b, {\it xmax}: ") - (text . "\newline\tab{2} ") - (bcStrings (10 "1.0" xmax F)) - (text . "\blankline") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Enter the value {\it y}a, {\it ymin}: ") - (text . "\newline\tab{2} ") - (bcStrings (10 "0.0" ymin F)) - (text . "\blankline") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Enter the value {\it y}b, {\it ymax}: ") - (text . "\newline\tab{2} ") - (bcStrings (10 "1.0" ymax F)) - (text . "\blankline") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Number of interior grid points in the {\it x}-direction ") - (text . "{\it ngx}: ") - (text . "\newline\tab{2} ") - (bcStrings (10 9 ngx PI)) - (text . "\blankline") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Number of interior grid points in the {\it y}-direction ") - (text . "{\it ngy}: ") - (text . "\newline\tab{2} ") - (bcStrings (10 9 ngy PI)) - (text . "\blankline") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "First dimension of A, {\it lda}: ") - (text . "\newline\tab{2} ") - (bcStrings (10 133 lda PI)) - (text . "\blankline") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "\newline Which {\it scheme} would you like to use: ") - (radioButtons scheme - (" C" " central differences" cent) - (" U" " upwind differences" up)) - (text . "\blankline") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "\newline Ifail value:") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'd03eefSolve) - htShowPage() - - - -d03eefSolve htPage == - xmin := htpLabelInputString(htPage,'xmin) - xmax := htpLabelInputString(htPage,'xmax) - ymin := htpLabelInputString(htPage,'ymin) - ymax := htpLabelInputString(htPage,'ymax) - ngx := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ngx) - objValUnwrap htpLabelSpadValue(htPage, 'ngx) - ngy := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ngy) - objValUnwrap htpLabelSpadValue(htPage, 'ngy) - lda := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lda) - objValUnwrap htpLabelSpadValue(htPage, 'lda) - diff := htpButtonValue(htPage,'scheme) - scheme := - diff = 'cent => '"C" - '"U" - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - d03eefDefaultSolve(htPage,xmin,xmax,ymin,ymax,ngx,ngy,lda,scheme,ifail) - -d03eefDefaultSolve(htPage,xmin,xmax,ymin,ymax,ngx,ngy,lda,scheme,ifail) == - page := htInitPage('"D03EEF - Discretize a 2nd order elliptic PDE on a rectangle",nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain F (Float))) - (text . "Please enter the values of \alpha to \psi to construct PDEF.") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "\alpha (x,y): \tab{10} ") - (bcStrings (46 1 alpha F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "\beta (x,y): \tab{10} ") - (bcStrings (46 0 beta F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "\gamma (x,y): \tab{10} ") - (bcStrings (46 1 gamma F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "\delta (x,y): \tab{10} ") - (bcStrings (46 50 delta F)) - (text . "\blankline") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "\epsilon (x,y): \tab{10} ") - (bcStrings (46 50 eps F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "\phi (x,y): \tab{10} ") - (bcStrings (46 0 phi F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "\psi (x,y): \tab{10} ") - (bcStrings (55 "-2*sin(X)*sin(Y) + 50*cos(X)*sin(Y) +50*sin(X)*cos(Y)" psi EM)) - (text . "\blankline ") - (text . "Please enter the boundary conditions a(x,y), b(x,y), and c(x,y) ") - (text . "for the top, bottom, left and right hand sides, to construct ") - (text . "BNDY. \blankline") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Bottom boundary conditions: ") - (text . "\newline a(x,y): \tab{10} ") - (bcStrings (46 0 a11 F)) - (text . "\newline b(x,y): \tab{10} ") - (bcStrings (46 1 a12 F)) - (text . "\newline c(x,y): \tab{10} ") - (bcStrings (46 "-sin(X)" a13 EM)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Right boundary conditions: ") - (text . "\newline a(x,y): \tab{10} ") - (bcStrings (46 1 a21 F)) - (text . "\newline b(x,y): \tab{10} ") - (bcStrings (46 0 a22 F)) - (text . "\newline c(x,y): \tab{10} ") - (bcStrings (46 "sin(X)*sin(Y)" a23 EM)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Top boundary conditions: ") - (text . "\newline a(x,y): \tab{10} ") - (bcStrings (46 1 a31 F)) - (text . "\newline b(x,y): \tab{10} ") - (bcStrings (46 0 a32 F)) - (text . "\newline c(x,y): \tab{10} ") - (bcStrings (46 "sin(X)*sin(Y)" a33 EM)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Left boundary conditions: ") - (text . "\newline a(x,y): \tab{10} ") - (bcStrings (46 0 a41 F)) - (text . "\newline b(x,y): \tab{10} ") - (bcStrings (46 1 a42 F)) - (text . "\newline c(x,y): \tab{10} ") - (bcStrings (46 "-sin(Y)" a43 EM))) - htMakeDoneButton('"Continue",'d03eefGen) - htpSetProperty(page,'xmin,xmin) - htpSetProperty(page,'xmax,xmax) - htpSetProperty(page,'ymin,ymin) - htpSetProperty(page,'ymax,ymax) - htpSetProperty(page,'ngx,ngx) - htpSetProperty(page,'ngy,ngy) - htpSetProperty(page,'lda,lda) - htpSetProperty(page,'scheme,scheme) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -d03eefGen htPage == - xmin := htpProperty(htPage, 'xmin) - xmax := htpProperty(htPage, 'xmax) - ymin := htpProperty(htPage, 'ymin) - ymax := htpProperty(htPage, 'ymax) - ngx := htpProperty(htPage, 'ngx) - ngy := htpProperty(htPage, 'ngy) - lda := htpProperty(htPage, 'lda) - scheme := htpProperty(htPage, 'scheme) - ifail := htpProperty(htPage, 'ifail) - alist := htpInputAreaAlist htPage - y := alist - for i in 1..4 repeat - for j in 1..3 repeat - v := STRCONC((first y).1," ") - rowList := [v,:rowList] - y := rest y - vList := [:vList,rowList] - rowList := [] - vList := reverse vList - astring := bcwords2liststring [bcwords2liststring x for x in vList] - for i in 1..7 repeat - utemp := STRCONC((first y).1," ") - uList := [utemp,:uList] - y := rest y - ustring := bcwords2liststring uList - prefix := STRCONC("d03eef(",xmin,", ",xmax,", ",ymin,", ",ymax,", ") - prefix := STRCONC(prefix,STRINGIMAGE ngx,", ",STRINGIMAGE ngy,", ") - prefix := STRCONC(prefix,STRINGIMAGE lda,",_"",scheme,"_", ") - prefix := STRCONC(prefix,STRINGIMAGE ifail,", (",ustring) - prefix := STRCONC(prefix,"::Vector Expression Float)::ASP73('PDEF),(") - prefix := STRCONC(prefix,astring,"::Matrix Expression Float)::ASP74('BNDY))") - linkGen prefix - -d03faf() == - htInitPage('"D03FAF - Elliptic PDE, Helmholtz equation, 3-D Cartesian co-ordinates",nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXd03faf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d03faf| '|NagPartialDifferentialEquationsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "D03FAF solves the three-dimensional Helmholtz equation ") - (text . "in cartesian co-ordinates: \center{\htbitmap{d03faf}} \newline ") - (text . "This subroutine forms the system of linear equations resulting ") - (text . "fom the standard seven-point finite difference equations, ") - (text . "and then solves the system using a method based on the fast ") - (text . "Fourier transform (FFT) described by Swartztrauber. ") - (text . "\blankline") - (text . "\newline ") - (text . "Read the input file to see the example program. ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "\spadcommand{)read d03faf \bound{s0}} ")) - htShowPage() -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/nag-e01.boot b/src/interp/nag-e01.boot new file mode 100644 index 00000000..51e56996 --- /dev/null +++ b/src/interp/nag-e01.boot @@ -0,0 +1,1760 @@ +-- 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. + + +)package "BOOT" + +e01baf() == + htInitPage('"E01BAF - Interpolating functions, cubic spline interpolant, one variable", nil) + htMakePage '( + (domainConditions + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXe01baf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e01baf| '|NagInterpolationPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "Determines a cubic B-spline interpolant ") + (text . "\center{s(x) = \htbitmap{e01baf}} to the points ") + (text . "(\htbitmap{xiii}, \htbitmap{yi}), for i = 1,2,...,m. ") + (text . "\blankline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "Enter the number of data points, {\it m}:") + (text . "\newline\tab{2} ") + (bcStrings (5 7 m PI)) + (text . "\blankline") + (text . "\newline") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Ifail value: ") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'e01bafSolve) + htShowPage() + +e01bafSolve htPage == + m := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) + objValUnwrap htpLabelSpadValue(htPage, 'm) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + m = '7 => e01bafDefaultSolve(htPage,ifail) + labelList := + "append"/[f(i) for i in 1..m] where f(i) == + prefix := ('"\newline \tab{2} ") + post := ('"\tab{32} ") + xnam := INTERN STRCONC ('"x",STRINGIMAGE i) + ynam := INTERN STRCONC ('"y",STRINGIMAGE i) + num := INTERN STRCONC (STRINGIMAGE (QUOTIENT(i,10)),".",STRINGIMAGE (REM(i,10))) + [['text,:prefix],['bcStrings,[10, num, xnam, 'F]], + ['text,:post],['bcStrings,[10, 0.0, ynam, 'F]]] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :labelList] + page := htInitPage("E01BAF - Interpolating functions, cubic spline interpolant, one variable",htpPropertyList htPage) + htSay '"\menuitemstyle{}\tab{2} Values of x: \tab{30} " + htSay '"\menuitemstyle{}\tab{32} Corresponding values of y: " + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'e01bafGen) + htpSetProperty(page,'m,m) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +e01bafDefaultSolve (htPage, ifail) == + m := '7 + page := htInitPage('"E01BAF - Interpolating functions, cubic spline interpolant, one variable",htpPropertyList htPage) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Values of x: \tab{30} ") + (text . "\menuitemstyle{}\tab{32} Corresponding values of y: ") + (text . "\newline \tab{2}") + (bcStrings (10 "0.0" x1 F)) + (text . "\tab{32} ") + (bcStrings (10 "1.0000" y1 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.2" x2 F)) + (text . "\tab{32} ") + (bcStrings (10 "1.2214" y2 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.4" x3 F)) + (text . "\tab{32} ") + (bcStrings (10 "1.4918" y3 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.6" x4 F)) + (text . "\tab{32} ") + (bcStrings (10 "1.8221" y4 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.75" x5 F)) + (text . "\tab{32} ") + (bcStrings (10 "2.1170" y5 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.9" x6 F)) + (text . "\tab{32} ") + (bcStrings (10 "2.4596" y6 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "1.0" x7 F)) + (text . "\tab{32} ") + (bcStrings (10 "2.7183" y7 F)) + (text . "\blankline")) + htMakeDoneButton('"Continue",'e01bafGen) + htpSetProperty(page,'m,m) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +e01bafGen htPage == + m := htpProperty(htPage,'m) + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + lck := m + 4 + lwrk := 6*m+16 + y := alist + while y repeat + right := STRCONC ((first y).1," ") + y := rest y + left := STRCONC ((first y).1," ") + y := rest y + reallist := [left,:reallist] + imaglist := [right,:imaglist] + realstring := bcwords2liststring reallist + imagstring := bcwords2liststring imaglist + pre := STRCONC ('"e01baf(",STRINGIMAGE m,",[",realstring,"],[",imagstring) + post := STRCONC ('"],",STRINGIMAGE lck,",",STRINGIMAGE lwrk,",") + linkGen STRCONC (pre,post,STRINGIMAGE ifail,")") + +e01bef() == + htInitPage('"E01BEF - Interpolating functions, monoticity preserving, piecewise cubic Hermite, one variable", nil) + htMakePage '( + (domainConditions + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXe01bef} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Brow[Cser operation page}{(|oPageFrom| '|e01bef| '|NagInterpolationPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "Determines derivative estimates defining a monoticity preserving") + (text . " piecewise cubic Hermite interpolant to the set of points ") + (text . "(\htbitmap{xr}, \htbitmap{fr}), ") + (text . "for r = 1,2,...,m. The interpolant, its derivative, and its ") + (text . "integral can be evaluated by calls to E01BFF, E01BGF or E01BHF. ") + (text . "\blankline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "Enter the number of data points {\it n} \htbitmap{great=} 2:") + (text . "\newline\tab{2} ") + (bcStrings (5 9 n PI)) + (text . "\blankline") + (text . "\newline") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Ifail value: ") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'e01befSolve) + htShowPage() + +e01befSolve htPage == + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + error = 'zero => '0 + '-1 + n = '9 => e01befDefaultSolve(htPage,ifail) + labelList := + "append"/[f(i) for i in 1..n] where f(i) == + prefix := ('"\newline \tab{2} ") + post := ('"\tab{32} ") + xnam := INTERN STRCONC ('"x",STRINGIMAGE i) + ynam := INTERN STRCONC ('"y",STRINGIMAGE i) + num := INTERN STRCONC (STRINGIMAGE (QUOTIENT(i,10)),".",STRINGIMAGE (REM(i,10))) + [['text,:prefix],['bcStrings,[10, num, xnam, 'F]], + ['text,:post],['bcStrings,[10, 0.0, ynam, 'F]]] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :labelList] + page := htInitPage("E01BEF - Interpolating functions, monoticity preserving, piecewise cubic Hermite, one variable",htpPropertyList htPage) + htSay '"\menuitemstyle{}\tab{2} Values of \space{1} " + htSay '"\htbitmap{xr}: \tab{30} " + htSay '"\menuitemstyle{}\tab{32} Values of \space{1} " + htSay '"\htbitmap{fr}: " + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'e01befGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +e01befDefaultSolve (htPage, ifail) == + n := '9 + page := htInitPage('"E01BEF - Interpolating functions, monoticity preserving, piecewise cubic Hermite, one variable",htpPropertyList htPage) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Values of \space{1} ") + (text . "\htbitmap{xr}: \tab{30} ") + (text . "\menuitemstyle{}\tab{32} Values of \space{1} \htbitmap{fr}: ") + (text . "\newline \tab{2}") + (bcStrings (10 "7.99" x1 F)) + (text . "\tab{32} ") + (bcStrings (10 "0.00000e+0" y1 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "8.09" x2 F)) + (text . "\tab{32} ") + (bcStrings (10 "0.27643e-4" y2 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "8.19" x3 F)) + (text . "\tab{32} ") + (bcStrings (10 "0.43750e-1" y3 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "8.70" x4 F)) + (text . "\tab{32} ") + (bcStrings (10 "0.16918" y4 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "9.20" x5 F)) + (text . "\tab{32} ") + (bcStrings (10 "0.46943" y5 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "10.00" x6 F)) + (text . "\tab{32} ") + (bcStrings (10 "0.94374" y6 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "12.00" x7 F)) + (text . "\tab{32} ") + (bcStrings (10 "0.99864" y7 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "15.00" x8 F)) + (text . "\tab{32} ") + (bcStrings (10 "0.99992" y8 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "20.00" x9 F)) + (text . "\tab{32} ") + (bcStrings (10 "0.99999" y9 F)) + (text . "\blankline")) + htMakeDoneButton('"Continue",'e01befGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +e01befGen htPage == + n := htpProperty(htPage,'n) + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + lck := n + 4 + lwrk := 6*n+16 + y := alist + while y repeat + right := STRCONC ((first y).1," ") + y := rest y + left := STRCONC ((first y).1," ") + y := rest y + reallist := [left,:reallist] + imaglist := [right,:imaglist] + realstring := bcwords2liststring reallist + imagstring := bcwords2liststring imaglist + linkGen STRCONC ('"e01bef(",STRINGIMAGE n,",[",realstring,"],[",imagstring,"],",STRINGIMAGE ifail,")") + + +e01bff() == + htInitPage('"E01BFF - Interpolated values, interpolant computed by E01BEF, function only, one variable", nil) + htMakePage '( + (domainConditions + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXe01bff} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e01bff| '|NagInterpolationPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "Evaluates the piecewise cubic Hermite interpolant computed ") + (text . "by E01BEF at the set of points \htbitmap{xiii}, ") + (text . "for i = 1,2,...,m. ") + (text . "\blankline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "Enter the number of data points {\em n}: ") + (text . "\newline\tab{2} ") + (bcStrings (5 9 n PI)) + (text . "\blankline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "Enter the number of evaluation points {\em m}: ") + (text . "\newline\tab{2} ") + (bcStrings (5 11 m PI)) + (text . "\blankline") + (text . "\newline") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Ifail value: ") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'e01bffSolve) + htShowPage() + +e01bffSolve htPage == + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + m := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) + objValUnwrap htpLabelSpadValue(htPage, 'm) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + (n = '9 and m = '11) => e01bffDefaultSolve(htPage,ifail) + labelList := + "append"/[f(i) for i in 1..n] where f(i) == + prefix := ('"\newline \tab{2} ") + middle := ('"\tab{22} ") + post := ('" \tab{42} ") + xnam := INTERN STRCONC ('"x",STRINGIMAGE i) + ynam := INTERN STRCONC ('"y",STRINGIMAGE i) + znam := INTERN STRCONC ('"z",STRINGIMAGE i) + num := INTERN STRCONC (STRINGIMAGE (QUOTIENT(i,10)),".",STRINGIMAGE (REM(i,10))) + [['text,:prefix],['bcStrings,[10, num, xnam, 'F]], + ['text,:middle],['bcStrings,[10, 0.0, ynam, 'F]], + ['text,:post],['bcStrings,[10, 0.0, znam, 'F]]] + pxwords := ('"\blankline \menuitemstyle{}\tab{2} Values of ") + pxwords := STRCONC(pxwords,'"array {\it Px}: \newline ") + pxwords := cons('text,pxwords) + pointList := + "append"/[g(j) for j in 1..m] where g(j) == + preamb := ('"\newline \tab{2} ") + pnam := INTERN STRCONC ('"px",STRINGIMAGE j) + [['text,:preamb],['bcStrings,[10, 0.0, pnam, 'F]]] + labelList := [:labelList,pxwords,:pointList] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :labelList] + page := htInitPage("E01BFF - Interpolated values, interpolant computed by E01BEF, function only, one variable",htpPropertyList htPage) + htSay '"\menuitemstyle{}\tab{2} Values of \space{1} " + htSay '"\htbitmap{xr}: \tab{20} \menuitemstyle{}\tab{22} " + htSay '"Values of \space{1} \htbitmap{fr}: \tab{40}" + htSay '"\menuitemstyle{}\tab{42} Values of \space{1} " + htSay '"\htbitmap{dr}: " + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'e01bffGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'m,m) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +e01bffDefaultSolve (htPage, ifail) == + n := '9 + m := '11 + page := htInitPage('"E01BFF - Interpolated values, interpolant computed by E01BEF, function only, one variable",htpPropertyList htPage) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Values of \space{1} ") + (text . "\htbitmap{xr}: \tab{20} \menuitemstyle{}\tab{22} ") + (text . "Values of \space{1} \htbitmap{fr}: \tab{40} ") + (text . "\menuitemstyle{}\tab{42} Values of \space{1} ") + (text . "\htbitmap{dr}: ") + (text . "\newline \tab{2}") + (bcStrings (10 "7.99" x1 F)) + (text . "\tab{22} ") + (bcStrings (10 "0.00000e+0" y1 F)) + (text . "\tab{42} ") + (bcStrings (10 "0.00000e+0" z1 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "8.09" x2 F)) + (text . "\tab{22} ") + (bcStrings (10 "0.27643e-4" y2 F)) + (text . "\tab{42} ") + (bcStrings (10 "5.52510e-4" z2 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "8.19" x3 F)) + (text . "\tab{22} ") + (bcStrings (10 "0.43750e-1" y3 F)) + (text . "\tab{42} ") + (bcStrings (10 "0.33587" z3 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "8.70" x4 F)) + (text . "\tab{22} ") + (bcStrings (10 "0.16918" y4 F)) + (text . "\tab{42} ") + (bcStrings (10 "0.34944" z4 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "9.20" x5 F)) + (text . "\tab{22} ") + (bcStrings (10 "0.46943" y5 F)) + (text . "\tab{42} ") + (bcStrings (10 "0.59696" z5 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "10.00" x6 F)) + (text . "\tab{22} ") + (bcStrings (10 "0.94374" y6 F)) + (text . "\tab{42} ") + (bcStrings (10 "6.03260e-2" z6 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "12.00" x7 F)) + (text . "\tab{22} ") + (bcStrings (10 "0.99864" y7 F)) + (text . "\tab{42} ") + (bcStrings (10 "8.98335e-4" z7 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "15.00" x8 F)) + (text . "\tab{22} ") + (bcStrings (10 "0.99992" y8 F)) + (text . "\tab{42} ") + (bcStrings (10 "2.93954e-5" z8 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "20.00" x9 F)) + (text . "\tab{22} ") + (bcStrings (10 "0.99999" y9 F)) + (text . "\tab{42} ") + (bcStrings (10 "0.00000" z9 F)) + (text . "\blankline") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Values of array {\it Px}: ") + (text . "\newline \tab{2} ") + (bcStrings (10 "7.99" px1 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "9.191" px2 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "10.392" px3 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "11.593" px4 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "12.794" px5 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "13.995" px6 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "15.196" px7 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "16.397" px8 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "17.598" px9 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "18.799" px10 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "20.0" px11 F)) + (text . "\blankline")) + htMakeDoneButton('"Continue",'e01bffGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'m,m) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +e01bffGen htPage == + n := htpProperty(htPage,'n) + m := htpProperty(htPage,'m) + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + lck := n + 4 + lwrk := 6*n+16 + y := alist + for i in 1..m repeat + px := STRCONC ((first y).1," ") + y := rest y + pxlist := [px,:pxlist] + pxstring := bcwords2liststring pxlist + while y repeat + right := STRCONC ((first y).1," ") + y := rest y + mid := STRCONC ((first y).1," ") + y := rest y + left := STRCONC ((first y).1," ") + y := rest y + xlist := [left,:xlist] + flist := [mid,:flist] + dlist := [right,:dlist] + xstring := bcwords2liststring xlist + fstring := bcwords2liststring flist + dstring := bcwords2liststring dlist + prefix := STRCONC('"e01bff(",STRINGIMAGE n,",[",xstring,"],[",fstring) + prefix := STRCONC(prefix,"],[",dstring,"],",STRINGIMAGE m,",[",pxstring,"],") + prefix := STRCONC(prefix,STRINGIMAGE ifail,")") + linkGen prefix + +e01bgf() == + htInitPage('"E01BGF - Interpolated values, interpolant computed by E01BEF, function and 1st derivative, one variable", nil) + htMakePage '( + (domainConditions + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXe01bgf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e01bgf| '|NagInterpolationPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "Evaluates the piecewise cubic Hermite interpolant computed ") + (text . "by E01BEF and its 1st derivative at the set of points \space{1} ") + (text . "\htbitmap{xiii}, for i = 1,2,...,m. ") + (text . "\blankline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "Enter the number of data points {\em n}: ") + (text . "\newline\tab{2} ") + (bcStrings (5 9 n PI)) + (text . "\blankline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "Enter the number of evaluation points {\em m}: ") + (text . "\newline\tab{2} ") + (bcStrings (5 11 m PI)) + (text . "\blankline") + (text . "\newline") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Ifail value: ") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'e01bgfSolve) + htShowPage() + +e01bgfSolve htPage == + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + m := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) + objValUnwrap htpLabelSpadValue(htPage, 'm) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + (n = '9 and m = '11) => e01bgfDefaultSolve(htPage,ifail) + labelList := + "append"/[f(i) for i in 1..n] where f(i) == + prefix := ('"\newline \tab{2} ") + middle := ('"\tab{22} ") + post := ('" \tab{42} ") + xnam := INTERN STRCONC ('"x",STRINGIMAGE i) + ynam := INTERN STRCONC ('"y",STRINGIMAGE i) + znam := INTERN STRCONC ('"z",STRINGIMAGE i) + num := INTERN STRCONC (STRINGIMAGE (QUOTIENT(i,10)),".",STRINGIMAGE (REM(i,10))) + [['text,:prefix],['bcStrings,[10, num, xnam, 'F]], + ['text,:middle],['bcStrings,[10, 0.0, ynam, 'F]], + ['text,:post],['bcStrings,[10, 0.0, znam, 'F]]] + pxwords := ('"\blankline \menuitemstyle{}\tab{2} Values of ") + pxwords := STRCONC(pxwords,'"array {\it Px}: \newline ") + pxwords := cons('text,pxwords) + pointList := + "append"/[g(j) for j in 1..m] where g(j) == + preamb := ('"\newline \tab{2} ") + pnam := INTERN STRCONC ('"px",STRINGIMAGE j) + [['text,:preamb],['bcStrings,[10, 0.0, pnam, 'F]]] + labelList := [:labelList,pxwords,:pointList] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :labelList] + page := htInitPage("E01BGF - Interpolated values, interpolant computed by E01BEF, function and 1st derivative, one variable",htpPropertyList htPage) + htSay '"\menuitemstyle{}\tab{2} Values of \space{1} " + htSay '"\htbitmap{xr}: \tab{20} \menuitemstyle{}\tab{22} " + htSay '"Values of \space{1} \htbitmap{fr}: \tab{40}" + htSay '"\menuitemstyle{}\tab{42} Values of \space{1} " + htSay '"\htbitmap{dr}: " + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'e01bgfGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'m,m) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +e01bgfDefaultSolve (htPage, ifail) == + n := '9 + m := '11 + page := htInitPage('"E01BGF - Interpolated values, interpolant computed by E01BEF, function and 1st derivative, one variable",htpPropertyList htPage) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\menuitemstyle{}\tab{2} Values of \space{1} ") + (text . "\htbitmap{xr}: \tab{20} \menuitemstyle{}\tab{22} ") + (text . "Values of \space{1} \htbitmap{fr}: \tab{40} ") + (text . "\menuitemstyle{}\tab{42} Values of \space{1} ") + (text . "\htbitmap{dr}: ") + (text . "\newline \tab{2}") + (bcStrings (10 "7.99" x1 F)) + (text . "\tab{22} ") + (bcStrings (10 "0.00000e+0" y1 F)) + (text . "\tab{42} ") + (bcStrings (10 "0.00000e+0" z1 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "8.09" x2 F)) + (text . "\tab{22} ") + (bcStrings (10 "0.27643e-4" y2 F)) + (text . "\tab{42} ") + (bcStrings (10 "5.52510e-4" z2 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "8.19" x3 F)) + (text . "\tab{22} ") + (bcStrings (10 "0.43750e-1" y3 F)) + (text . "\tab{42} ") + (bcStrings (10 "0.33587" z3 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "8.70" x4 F)) + (text . "\tab{22} ") + (bcStrings (10 "0.16918" y4 F)) + (text . "\tab{42} ") + (bcStrings (10 "0.34944" z4 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "9.20" x5 F)) + (text . "\tab{22} ") + (bcStrings (10 "0.46943" y5 F)) + (text . "\tab{42} ") + (bcStrings (10 "0.59696" z5 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "10.00" x6 F)) + (text . "\tab{22} ") + (bcStrings (10 "0.94374" y6 F)) + (text . "\tab{42} ") + (bcStrings (10 "6.03260e-2" z6 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "12.00" x7 F)) + (text . "\tab{22} ") + (bcStrings (10 "0.99864" y7 F)) + (text . "\tab{42} ") + (bcStrings (10 "8.98335e-4" z7 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "15.00" x8 F)) + (text . "\tab{22} ") + (bcStrings (10 "0.99992" y8 F)) + (text . "\tab{42} ") + (bcStrings (10 "2.93954e-5" z8 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "20.00" x9 F)) + (text . "\tab{22} ") + (bcStrings (10 "0.99999" y9 F)) + (text . "\tab{42} ") + (bcStrings (10 "0.00000" z9 F)) + (text . "\blankline") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Values of array {\it Px}: ") + (text . "\newline \tab{2} ") + (bcStrings (10 "7.99" px1 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "9.191" px2 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "10.392" px3 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "11.593" px4 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "12.794" px5 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "13.995" px6 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "15.196" px7 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "16.397" px8 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "17.598" px9 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "18.799" px10 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "20.0" px11 F)) + (text . "\blankline")) + htMakeDoneButton('"Continue",'e01bgfGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'m,m) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +e01bgfGen htPage == + n := htpProperty(htPage,'n) + m := htpProperty(htPage,'m) + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + lck := n + 4 + lwrk := 6*n+16 + y := alist + for i in 1..m repeat + px := STRCONC ((first y).1," ") + y := rest y + pxlist := [px,:pxlist] + pxstring := bcwords2liststring pxlist + while y repeat + right := STRCONC ((first y).1," ") + y := rest y + mid := STRCONC ((first y).1," ") + y := rest y + left := STRCONC ((first y).1," ") + y := rest y + xlist := [left,:xlist] + flist := [mid,:flist] + dlist := [right,:dlist] + xstring := bcwords2liststring xlist + fstring := bcwords2liststring flist + dstring := bcwords2liststring dlist + prefix := STRCONC('"e01bgf(",STRINGIMAGE n,",[",xstring,"],[",fstring) + prefix := STRCONC(prefix,"],[",dstring,"],",STRINGIMAGE m,",[",pxstring,"],") + prefix := STRCONC(prefix,STRINGIMAGE ifail,")") + linkGen prefix + +e01bhf() == + htInitPage('"E01BHF - Interpolated values, interpolant computed by E01BEF, definite integral, one variable", nil) + htMakePage '( + (domainConditions + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXe01bhf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e01bhf| '|NagInterpolationPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "Evaluates the definite integral of the piecewise cubic Hermite ") + (text . "interpolant computed by E01BEF over the interval [a,b]. ") + (text . "\blankline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "Enter the number of data points {\em n}: ") + (text . "\newline\tab{2} ") + (bcStrings (5 9 n PI)) + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} ") + (text . "\newline {\em Lower} bound {\it a}: ") + (text . "\tab{32} \menuitemstyle{}\tab{34} ") + (text . "{\em Upper} bound {\it b}:") + (text . "\newline\tab{2} ") + (bcStrings (20 "7.99" a F)) + (text . "\tab{34} ") + (bcStrings (20 "20.0" b EM)) + (text . "\blankline") + (text . "\newline") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Ifail value: ") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'e01bhfSolve) + htShowPage() + +e01bhfSolve htPage == + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + a := htpLabelInputString(htPage,'a) + b := htpLabelInputString(htPage,'b) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + n = '9 => e01bhfDefaultSolve(htPage,a,b,ifail) + labelList := + "append"/[f(i) for i in 1..n] where f(i) == + prefix := ('"\newline \tab{2} ") + middle := ('"\tab{22} ") + post := ('" \tab{42} ") + xnam := INTERN STRCONC ('"x",STRINGIMAGE i) + ynam := INTERN STRCONC ('"y",STRINGIMAGE i) + znam := INTERN STRCONC ('"z",STRINGIMAGE i) + num := INTERN STRCONC (STRINGIMAGE (QUOTIENT(i,10)),".",STRINGIMAGE (REM(i,10))) + [['text,:prefix],['bcStrings,[10, num, xnam, 'F]], + ['text,:middle],['bcStrings,[10, 0.0, ynam, 'F]], + ['text,:post],['bcStrings,[10, 0.0, znam, 'F]]] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :labelList] + page := htInitPage("E01BHF - Interpolated values, interpolant computed by E01BEF, definite integral, one variable",htpPropertyList htPage) + htSay '"\menuitemstyle{}\tab{2} Values of \space{1} " + htSay '"\htbitmap{xr}: \tab{20} \menuitemstyle{}\tab{22} " + htSay '"Values of \space{1} \htbitmap{fr}: \tab{40}" + htSay '"\menuitemstyle{}\tab{42} Values of \space{1} " + htSay '"\htbitmap{dr}: " + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'e01bhfGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'a,a) + htpSetProperty(page,'b,b) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +e01bhfDefaultSolve (htPage,a,b,ifail) == + n := '9 + page := htInitPage('"E01BHF - Interpolated values, interpolant computed by E01BEF, definite integral, one variable",htpPropertyList htPage) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\menuitemstyle{}\tab{2} Values of \space{1} ") + (text . "\htbitmap{xr}: \tab{20} \menuitemstyle{}\tab{22} ") + (text . "Values of \space{1} \htbitmap{fr}: \tab{40} ") + (text . "\menuitemstyle{}\tab{42} Values of \space{1} ") + (text . "\htbitmap{dr}: ") + (text . "\newline \tab{2}") + (bcStrings (10 "7.99" x1 F)) + (text . "\tab{22} ") + (bcStrings (10 "0.00000e+0" y1 F)) + (text . "\tab{42} ") + (bcStrings (10 "0.00000e+0" z1 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "8.09" x2 F)) + (text . "\tab{22} ") + (bcStrings (10 "0.27643e-4" y2 F)) + (text . "\tab{42} ") + (bcStrings (10 "5.52510e-4" z2 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "8.19" x3 F)) + (text . "\tab{22} ") + (bcStrings (10 "0.43750e-1" y3 F)) + (text . "\tab{42} ") + (bcStrings (10 "0.33587" z3 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "8.70" x4 F)) + (text . "\tab{22} ") + (bcStrings (10 "0.16918" y4 F)) + (text . "\tab{42} ") + (bcStrings (10 "0.34944" z4 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "9.20" x5 F)) + (text . "\tab{22} ") + (bcStrings (10 "0.46943" y5 F)) + (text . "\tab{42} ") + (bcStrings (10 "0.59696" z5 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "10.00" x6 F)) + (text . "\tab{22} ") + (bcStrings (10 "0.94374" y6 F)) + (text . "\tab{42} ") + (bcStrings (10 "6.03260e-2" z6 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "12.00" x7 F)) + (text . "\tab{22} ") + (bcStrings (10 "0.99864" y7 F)) + (text . "\tab{42} ") + (bcStrings (10 "8.98335e-4" z7 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "15.00" x8 F)) + (text . "\tab{22} ") + (bcStrings (10 "0.99992" y8 F)) + (text . "\tab{42} ") + (bcStrings (10 "2.93954e-5" z8 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "20.00" x9 F)) + (text . "\tab{22} ") + (bcStrings (10 "0.99999" y9 F)) + (text . "\tab{42} ") + (bcStrings (10 "0.00000" z9 F)) + (text . "\blankline")) + htMakeDoneButton('"Continue",'e01bhfGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'a,a) + htpSetProperty(page,'b,b) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +e01bhfGen htPage == + n := htpProperty(htPage,'n) + a := htpProperty(htPage,'a) + b := htpProperty(htPage,'b) + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + lck := n + 4 + lwrk := 6*n+16 + y := alist + while y repeat + right := STRCONC ((first y).1," ") + y := rest y + mid := STRCONC ((first y).1," ") + y := rest y + left := STRCONC ((first y).1," ") + y := rest y + xlist := [left,:xlist] + flist := [mid,:flist] + dlist := [right,:dlist] + xstring := bcwords2liststring xlist + fstring := bcwords2liststring flist + dstring := bcwords2liststring dlist + prefix := STRCONC('"e01bhf(",STRINGIMAGE n,",[",xstring,"],[",fstring,"],[") + prefix := STRCONC(prefix,dstring,"],",STRINGIMAGE a,",",STRINGIMAGE b,",",STRINGIMAGE ifail,")") + linkGen prefix + + +e01daf() == + htInitPage('"E01DAF - Interpolating functions, fitting bicubic spline, data on a rectangular grid", nil) + htMakePage '( + (domainConditions + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXe01daf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e01daf| '|NagInterpolationPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "Determines a bicubic spline surface interpolating the set of ") + (text . "data values (\htbitmap{xr}, \htbitmap{yr}, \htbitmap{fqr}) ") + (text . "given on a rectangular grid. The grid is defined by ") + (text . "\space{1} \htbitmap{mx} points along the x-axis and ") + (text . "\space{1} \htbitmap{my} points along the y-axis. The ") + (text . "spline has \space{1} \htbitmap{px} knots ") + (text . "\htbitmap{lamdai} and \space{1}\htbitmap{py}") + (text . " knots \htbitmap{mui} in the x- and y-directions ") + (text . "respectively, and is given in the B-spline representation ") + (text . "\center{s(x,y) = \htbitmap{e01daf1}} ") + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} ") + (text . "\newline The value \space{1} \htbitmap{mx}: ") + (text . "\tab{32} \menuitemstyle{}\tab{34} ") + (text . "The value \space{1} \htbitmap{my}:") + (text . "\newline\tab{2} ") + (bcStrings (6 7 mx PI)) + (text . "\tab{34} ") + (bcStrings (6 6 my PI)) + (text . "\blankline") + (text . "\newline") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Ifail value: ") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'e01dafSolve) + htShowPage() + +e01dafSolve htPage == + mx := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'mx) + objValUnwrap htpLabelSpadValue(htPage, 'mx) + my := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'my) + objValUnwrap htpLabelSpadValue(htPage, 'my) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + (mx = '7 and my = '6) => e01dafDefaultSolve(htPage,ifail) + xList := + "append"/[f(i) for i in 1..mx] where f(i) == + xnam := INTERN STRCONC ('"x",STRINGIMAGE i) + [['bcStrings,[6, 0.0, xnam, 'F]]] + prefix := ('"\newline \menuitemstyle{}\tab{2} Values of X(1) to X(MX): \newline ") + xList := [['text,:prefix],:xList] + yList := + "append"/[g(i) for i in 1..my] where g(i) == + ynam := INTERN STRCONC ('"y",STRINGIMAGE i) + [['bcStrings,[6, 0.0, ynam, 'F]]] + prefix := ('"\blankline\menuitemstyle{}\tab{2}Values of Y(1) to Y(MY): \newline ") + yList := [['text,:prefix],:yList] + fList := + "append"/[h(j,my) for j in 1..mx] where h(j,my) == + tempList := + "append"/[k(j,m) for m in 1..my] where k(j,m) == + fnam := INTERN STRCONC ('"f",STRINGIMAGE j, STRINGIMAGE m) + [['bcStrings,[6, 0.0, fnam, 'F]]] + prefix := ('"\newline ") + tempList := [['text,:prefix],:tempList] + prefix := ('"\blankline \menuitemstyle{} \tab{2} Values of F(MX*MY) ") + prefix := STRCONC(prefix,'"(x down, y across): ") + fList := [['text,:prefix],:fList] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :xList,:yList,:fList] + page := htInitPage("E01DAF - Interpolating functions, fitting bicubic spline, data on a rectanglar grid",htpPropertyList htPage) + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'e01dafGen) + htpSetProperty(page,'mx,mx) + htpSetProperty(page,'my,my) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +e01dafDefaultSolve (htPage,ifail) == + mx := '7 + my := '6 + page := htInitPage('"E01DAF - Interpolating functions, fitting bicubic spline, data on rectangular grid",htpPropertyList htPage) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\menuitemstyle{}\tab{2} Values of X(1) to X(MX): ") + (text . "\newline ") + (bcStrings (6 "1.00" x1 F)) + (bcStrings (6 "1.10" x2 F)) + (bcStrings (6 "1.30" x3 F)) + (bcStrings (6 "1.50" x4 F)) + (bcStrings (6 "1.60" x5 F)) + (bcStrings (6 "1.80" x6 F)) + (bcStrings (6 "2.00" x7 F)) + (text . "\blankline ") + (text . "\newline ") + (text ."\menuitemstyle{} \tab{2} Values of Y(1) to Y(MY): ") + (text . "\newline ") + (bcStrings (6 "0.00" y1 F)) + (bcStrings (6 "0.10" y2 F)) + (bcStrings (6 "0.40" y3 F)) + (bcStrings (6 "0.70" y4 F)) + (bcStrings (6 "0.90" y5 F)) + (bcStrings (6 "1.00" y6 F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} Values of F(MX*MY) (x down, y across): ") + (text . "\newline ") + (bcStrings (6 "1.00" z11 F)) + (bcStrings (6 "1.10" z21 F)) + (bcStrings (6 "1.40" z31 F)) + (bcStrings (6 "1.70" z41 F)) + (bcStrings (6 "1.90" z51 F)) + (bcStrings (6 "2.00" z61 F)) + (text . "\newline ") + (bcStrings (6 "1.21" z12 F)) + (bcStrings (6 "1.31" z22 F)) + (bcStrings (6 "1.61" z32 F)) + (bcStrings (6 "1.91" z42 F)) + (bcStrings (6 "2.11" z52 F)) + (bcStrings (6 "2.21" z62 F)) + (text . "\newline ") + (bcStrings (6 "1.69" z13 F)) + (bcStrings (6 "1.79" z23 F)) + (bcStrings (6 "2.09" z33 F)) + (bcStrings (6 "2.39" z43 F)) + (bcStrings (6 "2.59" z53 F)) + (bcStrings (6 "2.69" z63 F)) + (text . "\newline ") + (bcStrings (6 "2.25" z14 F)) + (bcStrings (6 "2.35" z24 F)) + (bcStrings (6 "2.65" z34 F)) + (bcStrings (6 "2.95" z44 F)) + (bcStrings (6 "3.15" z54 F)) + (bcStrings (6 "3.25" z64 F)) + (text . "\newline ") + (bcStrings (6 "2.56" z15 F)) + (bcStrings (6 "2.66" z25 F)) + (bcStrings (6 "2.96" z35 F)) + (bcStrings (6 "3.26" z45 F)) + (bcStrings (6 "3.46" z55 F)) + (bcStrings (6 "3.56" z65 F)) + (text . "\newline ") + (bcStrings (6 "3.24" z16 F)) + (bcStrings (6 "3.34" z26 F)) + (bcStrings (6 "3.64" z36 F)) + (bcStrings (6 "3.94" z46 F)) + (bcStrings (6 "4.14" z56 F)) + (bcStrings (6 "4.24" z66 F)) + (text . "\newline ") + (bcStrings (6 "4.00" z17 F)) + (bcStrings (6 "4.10" z27 F)) + (bcStrings (6 "4.40" z37 F)) + (bcStrings (6 "4.70" z47 F)) + (bcStrings (6 "4.90" z57 F)) + (bcStrings (6 "5.00" z67 F)) + (text . "\blankline")) + htMakeDoneButton('"Continue",'e01dafGen) + htpSetProperty(page,'mx,mx) + htpSetProperty(page,'my,my) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +e01dafGen htPage == + mx := htpProperty(htPage,'mx) + my := htpProperty(htPage,'my) + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + while y repeat + right := STRCONC ((first y).1, " ") + y := rest y + xlist := [right,:xlist] + for i in 1..mx repeat + xmx := [:xmx,(first xlist)] + xlist := rest xlist + xstring := bcwords2liststring xmx + for i in 1..my repeat + ymy := [:ymy,(first xlist)] + xlist := rest xlist + ystring := bcwords2liststring ymy + fstring := bcwords2liststring xlist + prefix := STRCONC('"e01daf(",STRINGIMAGE mx,", ",STRINGIMAGE my,",[") + midd := STRCONC(xstring, "], [",ystring,"], [",fstring,"], ") + linkGen STRCONC(prefix,midd,STRINGIMAGE ifail,")") + +e01saf() == + htInitPage('"E01SAF - Interpolating functions, method of Renka and Cline, two variables", nil) + htMakePage '( + (domainConditions + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXe01saf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e01saf| '|NagInterpolationPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "Determines a \htbitmap{c1} piecewise polynomial ") + (text . "surface F(x,y) interpolating the set of scattered points ") + (text . "(\htbitmap{xr}, \htbitmap{yr}, \htbitmap{fqr}), ") + (text . "for r = 1,2,...,m, using a method of Renka and Cline. ") + (text . "The interpolant can be evaluated using E01SBF. ") + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} \newline ") + (text . "Number of data points {\em m} \htbitmap{great=} 3:") + (text . "\newline \tab{2} ") + (bcStrings (6 30 m PI)) + (text . "\blankline") + (text . "\newline") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Ifail value: ") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'e01safSolve) + htShowPage() + +e01safSolve htPage == + m := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) + objValUnwrap htpLabelSpadValue(htPage, 'm) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + m = '30 => e01safDefaultSolve(htPage,ifail) + labelList := + "append"/[f(i) for i in 1..m] where f(i) == + prefix := ('"\newline \tab{2} ") + middle := ('"\tab{22} ") + post := ('" \tab{42} ") + xnam := INTERN STRCONC ('"x",STRINGIMAGE i) + ynam := INTERN STRCONC ('"y",STRINGIMAGE i) + znam := INTERN STRCONC ('"z",STRINGIMAGE i) + num := INTERN STRCONC (STRINGIMAGE (QUOTIENT(i,10)),".",STRINGIMAGE (REM(i,10))) + [['text,:prefix],['bcStrings,[10, num, xnam, 'F]], + ['text,:middle],['bcStrings,[10, 0.0, ynam, 'F]], + ['text,:post],['bcStrings,[10, 0.0, znam, 'F]]] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :labelList] + page := htInitPage("E01SAF - Interpolating functions, method of Renka and Cline,two variables",htpPropertyList htPage) + htSay '"\menuitemstyle{}\tab{2} Values of \space{1} " + htSay '"\htbitmap{xr}: \tab{20} \menuitemstyle{}\tab{22} " + htSay '"Values of \space{1} \htbitmap{fr}: \tab{40}" + htSay '"\menuitemstyle{}\tab{42} Values of \space{1} " + htSay '"\htbitmap{dr}: " + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'e01safGen) + htpSetProperty(page,'m,m) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +e01safDefaultSolve (htPage, ifail) == + m := '30 + page := htInitPage('"E01SAF - Interpolating functions, method of Renka and Cline, two variables",htpPropertyList htPage) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\menuitemstyle{}\tab{2} Values of \space{1} ") + (text . "\htbitmap{xr}: \tab{20} \menuitemstyle{}\tab{22} ") + (text . "Values of \space{1} \htbitmap{fr}: \tab{40} ") + (text . "\menuitemstyle{}\tab{42} Values of \space{1} ") + (text . "\htbitmap{dr}: ") + (text . "\newline \tab{2}") + (bcStrings (10 "11.16" x1 F)) + (text . "\tab{22} ") + (bcStrings (10 "1.24" y1 F)) + (text . "\tab{42} ") + (bcStrings (10 "22.15" z1 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "12.85" x2 F)) + (text . "\tab{22} ") + (bcStrings (10 "3.06" y2 F)) + (text . "\tab{42} ") + (bcStrings (10 "22.11" z2 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "19.85" x3 F)) + (text . "\tab{22} ") + (bcStrings (10 "10.72" y3 F)) + (text . "\tab{42} ") + (bcStrings (10 "7.97" z3 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "19.72" x4 F)) + (text . "\tab{22} ") + (bcStrings (10 "1.39" y4 F)) + (text . "\tab{42} ") + (bcStrings (10 "16.83" z4 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "15.91" x5 F)) + (text . "\tab{22} ") + (bcStrings (10 "7.74" y5 F)) + (text . "\tab{42} ") + (bcStrings (10 "15.30" z5 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.00" x6 F)) + (text . "\tab{22} ") + (bcStrings (10 "20.00" y6 F)) + (text . "\tab{42} ") + (bcStrings (10 "34.60" z6 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "20.87" x7 F)) + (text . "\tab{22} ") + (bcStrings (10 "20.00" y7 F)) + (text . "\tab{42} ") + (bcStrings (10 "5.74" z7 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "3.45" x8 F)) + (text . "\tab{22} ") + (bcStrings (10 "12.78" y8 F)) + (text . "\tab{42} ") + (bcStrings (10 "41.24" z8 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "14.26" x9 F)) + (text . "\tab{22} ") + (bcStrings (10 "17.87" y9 F)) + (text . "\tab{42} ") + (bcStrings (10 "10.74" z9 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "17.43" x10 F)) + (text . "\tab{22} ") + (bcStrings (10 "3.46" y10 F)) + (text . "\tab{42} ") + (bcStrings (10 "18.60" z10 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "22.80" x11 F)) + (text . "\tab{22} ") + (bcStrings (10 "12.39" y11 F)) + (text . "\tab{42} ") + (bcStrings (10 "5.47" z11 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "7.58" x12 F)) + (text . "\tab{22} ") + (bcStrings (10 "1.98" y12 F)) + (text . "\tab{42} ") + (bcStrings (10 "29.87" z12 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "25.00" x13 F)) + (text . "\tab{22} ") + (bcStrings (10 "11.87" y13 F)) + (text . "\tab{42} ") + (bcStrings (10 "4.40" z13 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.00" x14 F)) + (text . "\tab{22} ") + (bcStrings (10 "0.00" y14 F)) + (text . "\tab{42} ") + (bcStrings (10 "58.20" z14 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "9.66" x15 F)) + (text . "\tab{22} ") + (bcStrings (10 "20.00" y15 F)) + (text . "\tab{42} ") + (bcStrings (10 "4.73" z15 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "5.22" x16 F)) + (text . "\tab{22} ") + (bcStrings (10 "14.66" y16 F)) + (text . "\tab{42} ") + (bcStrings (10 "40.36" z16 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "17.25" x17 F)) + (text . "\tab{22} ") + (bcStrings (10 "19.57" y17 F)) + (text . "\tab{42} ") + (bcStrings (10 "6.43" z17 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "25.00" x18 F)) + (text . "\tab{22} ") + (bcStrings (10 "3.87" y18 F)) + (text . "\tab{42} ") + (bcStrings (10 "8.74" z18 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "12.13" x19 F)) + (text . "\tab{22} ") + (bcStrings (10 "10.79" y19 F)) + (text . "\tab{42} ") + (bcStrings (10 "13.71" z19 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "22.23" x20 F)) + (text . "\tab{22} ") + (bcStrings (10 "6.21" y20 F)) + (text . "\tab{42} ") + (bcStrings (10 "10.25" z20 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "11.52" x21 F)) + (text . "\tab{22} ") + (bcStrings (10 "8.53" y21 F)) + (text . "\tab{42} ") + (bcStrings (10 "15.74" z21 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "15.20" x22 F)) + (text . "\tab{22} ") + (bcStrings (10 "0.0" y22 F)) + (text . "\tab{42} ") + (bcStrings (10 "21.60" z22 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "7.54" x23 F)) + (text . "\tab{22} ") + (bcStrings (10 "10.69" y23 F)) + (text . "\tab{42} ") + (bcStrings (10 "19.31" z23 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "17.32" x24 F)) + (text . "\tab{22} ") + (bcStrings (10 "13.78" y24 F)) + (text . "\tab{42} ") + (bcStrings (10 "12.11" z24 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "2.14" x25 F)) + (text . "\tab{22} ") + (bcStrings (10 "15.03" y25 F)) + (text . "\tab{42} ") + (bcStrings (10 "53.10" z25 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.51" x26 F)) + (text . "\tab{22} ") + (bcStrings (10 "8.37" y26 F)) + (text . "\tab{42} ") + (bcStrings (10 "49.43" z26 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "22.69" x27 F)) + (text . "\tab{22} ") + (bcStrings (10 "19.63" y27 F)) + (text . "\tab{42} ") + (bcStrings (10 "3.25" z27 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "5.47" x28 F)) + (text . "\tab{22} ") + (bcStrings (10 "17.13" y28 F)) + (text . "\tab{42} ") + (bcStrings (10 "28.63" z28 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "21.67" x29 F)) + (text . "\tab{22} ") + (bcStrings (10 "14.36" y29 F)) + (text . "\tab{42} ") + (bcStrings (10 "5.52" z29 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "3.31" x30 F)) + (text . "\tab{22} ") + (bcStrings (10 "0.33" y30 F)) + (text . "\tab{42} ") + (bcStrings (10 "44.08" z30 F)) + (text . "\blankline")) + htMakeDoneButton('"Continue",'e01safGen) + htpSetProperty(page,'m,m) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +e01safGen htPage == + m := htpProperty(htPage,'m) + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + while y repeat + right := STRCONC ((first y).1," ") + y := rest y + mid := STRCONC ((first y).1," ") + y := rest y + left := STRCONC ((first y).1," ") + y := rest y + xlist := [left,:xlist] + flist := [mid,:flist] + dlist := [right,:dlist] + xstring := bcwords2liststring xlist + fstring := bcwords2liststring flist + dstring := bcwords2liststring dlist + prefix := STRCONC('"e01saf(",STRINGIMAGE m,",[",xstring,"],[",fstring,"],[") + prefix := STRCONC(prefix,dstring,"],",STRINGIMAGE ifail,")") + linkGen prefix + +e01sef() == + htInitPage('"E01SEF - Interpolating functions, modified Shepard's method, two variables", nil) + htMakePage '( + (domainConditions + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXe01sef} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e01sef| '|NagInterpolationPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "Determines a \htbitmap{c1} piecewise polynomial ") + (text . "surface F(x,y) interpolating the set of scattered points ") + (text . "(\htbitmap{xr}, \htbitmap{yr}, \htbitmap{fqr}), ") + (text . "for r = 1,2,...,m, using a modified Shepard method. ") + (text . "The interpolant can be evaluated using E01SFF. ") + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} \newline ") + (text . "Number of data points {\em m} \htbitmap{great=} 3:") + (text . "\newline \tab{2} ") + (bcStrings (6 30 m PI)) + (text . "\blankline ") + (text . "Note: RNW, RNQ, NW, NQ set to zero for default value. ") + (text . "On exit, they contain the value actually used. ") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "\newline {\em RNW} weight locality radius: ") + (text . "\tab{32} \menuitemstyle{}\tab{34}") + (text . "{\em RNQ} point locality radius:") + (text . "\newline\tab{2} ") + (bcStrings (6 "0.0" rnw F)) + (text . "\tab{34} ") + (bcStrings (6 "0.0" rnq F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} \newline") + (text . "{\em NW} average number of points within RNW of each point: ") + (text . "\newline \tab{2} ") + (bcStrings (6 0 nw I)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} \newline") + (text . "{\em NQ} average number of points within RNQ of each point: ") + (text . "\newline \tab{2} ") + (bcStrings (6 0 nq I)) + (text . "\blankline") + (text . "\newline") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Ifail value: ") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'e01sefSolve) + htShowPage() + +e01sefSolve htPage == + m := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) + objValUnwrap htpLabelSpadValue(htPage, 'm) + nw := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nw) + objValUnwrap htpLabelSpadValue(htPage, 'nw) + nq := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nq) + objValUnwrap htpLabelSpadValue(htPage, 'nq) + rnq := htpLabelInputString(htPage,'rnq) + rnw := htpLabelInputString(htPage,'rnw) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + m = '30 => e01sefDefaultSolve(htPage,rnq,rnw,nq,nw,ifail) + labelList := + "append"/[f(i) for i in 1..m] where f(i) == + prefix := ('"\newline \tab{2} ") + middle := ('"\tab{22} ") + post := ('" \tab{42} ") + xnam := INTERN STRCONC ('"x",STRINGIMAGE i) + ynam := INTERN STRCONC ('"y",STRINGIMAGE i) + znam := INTERN STRCONC ('"z",STRINGIMAGE i) + num := INTERN STRCONC (STRINGIMAGE (QUOTIENT(i,10)),".",STRINGIMAGE (REM(i,10))) + [['text,:prefix],['bcStrings,[10, num, xnam, 'F]], + ['text,:middle],['bcStrings,[10, 0.0, ynam, 'F]], + ['text,:post],['bcStrings,[10, 0.0, znam, 'F]]] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :labelList] + page := htInitPage("E01SEF - Interpolating functions, modified Shepard's method, two variables",htpPropertyList htPage) + htSay '"\menuitemstyle{}\tab{2} Values of \space{1} " + htSay '"\htbitmap{xr}: \tab{20} \menuitemstyle{}\tab{22} " + htSay '"Values of \space{1} \htbitmap{fr}: \tab{40}" + htSay '"\menuitemstyle{}\tab{42} Values of \space{1} " + htSay '"\htbitmap{dr}: " + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'e01sefGen) + htpSetProperty(page,'m,m) + htpSetProperty(page,'rnq,rnq) + htpSetProperty(page,'rnw,rnw) + htpSetProperty(page,'nq,nq) + htpSetProperty(page,'nw,nw) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +e01sefDefaultSolve (htPage,rnq,rnw,nq,nw,ifail) == + m := '30 + page := htInitPage('"E01SEF - Interpolating functions, modified Shepard's method, two variables",htpPropertyList htPage) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\menuitemstyle{}\tab{2} Values of \space{1} ") + (text . "\htbitmap{xr}: \tab{20} \menuitemstyle{}\tab{22} ") + (text . "Values of \space{1} \htbitmap{fr}: \tab{40} ") + (text . "\menuitemstyle{}\tab{42} Values of \space{1} ") + (text . "\htbitmap{dr}: ") + (text . "\newline \tab{2}") + (bcStrings (10 "11.16" x1 F)) + (text . "\tab{22} ") + (bcStrings (10 "1.24" y1 F)) + (text . "\tab{42} ") + (bcStrings (10 "22.15" z1 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "12.85" x2 F)) + (text . "\tab{22} ") + (bcStrings (10 "3.06" y2 F)) + (text . "\tab{42} ") + (bcStrings (10 "22.11" z2 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "19.85" x3 F)) + (text . "\tab{22} ") + (bcStrings (10 "10.72" y3 F)) + (text . "\tab{42} ") + (bcStrings (10 "7.97" z3 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "19.72" x4 F)) + (text . "\tab{22} ") + (bcStrings (10 "1.39" y4 F)) + (text . "\tab{42} ") + (bcStrings (10 "16.83" z4 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "15.91" x5 F)) + (text . "\tab{22} ") + (bcStrings (10 "7.74" y5 F)) + (text . "\tab{42} ") + (bcStrings (10 "15.30" z5 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.00" x6 F)) + (text . "\tab{22} ") + (bcStrings (10 "20.00" y6 F)) + (text . "\tab{42} ") + (bcStrings (10 "34.60" z6 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "20.87" x7 F)) + (text . "\tab{22} ") + (bcStrings (10 "20.00" y7 F)) + (text . "\tab{42} ") + (bcStrings (10 "5.74" z7 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "3.45" x8 F)) + (text . "\tab{22} ") + (bcStrings (10 "12.78" y8 F)) + (text . "\tab{42} ") + (bcStrings (10 "41.24" z8 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "14.26" x9 F)) + (text . "\tab{22} ") + (bcStrings (10 "17.87" y9 F)) + (text . "\tab{42} ") + (bcStrings (10 "10.74" z9 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "17.43" x10 F)) + (text . "\tab{22} ") + (bcStrings (10 "3.46" y10 F)) + (text . "\tab{42} ") + (bcStrings (10 "18.60" z10 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "22.80" x11 F)) + (text . "\tab{22} ") + (bcStrings (10 "12.39" y11 F)) + (text . "\tab{42} ") + (bcStrings (10 "5.47" z11 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "7.58" x12 F)) + (text . "\tab{22} ") + (bcStrings (10 "1.98" y12 F)) + (text . "\tab{42} ") + (bcStrings (10 "29.87" z12 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "25.00" x13 F)) + (text . "\tab{22} ") + (bcStrings (10 "11.87" y13 F)) + (text . "\tab{42} ") + (bcStrings (10 "4.40" z13 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.00" x14 F)) + (text . "\tab{22} ") + (bcStrings (10 "0.00" y14 F)) + (text . "\tab{42} ") + (bcStrings (10 "58.20" z14 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "9.66" x15 F)) + (text . "\tab{22} ") + (bcStrings (10 "20.00" y15 F)) + (text . "\tab{42} ") + (bcStrings (10 "4.73" z15 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "5.22" x16 F)) + (text . "\tab{22} ") + (bcStrings (10 "14.66" y16 F)) + (text . "\tab{42} ") + (bcStrings (10 "40.36" z16 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "17.25" x17 F)) + (text . "\tab{22} ") + (bcStrings (10 "19.57" y17 F)) + (text . "\tab{42} ") + (bcStrings (10 "6.43" z17 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "25.00" x18 F)) + (text . "\tab{22} ") + (bcStrings (10 "3.87" y18 F)) + (text . "\tab{42} ") + (bcStrings (10 "8.74" z18 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "12.13" x19 F)) + (text . "\tab{22} ") + (bcStrings (10 "10.79" y19 F)) + (text . "\tab{42} ") + (bcStrings (10 "13.71" z19 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "22.23" x20 F)) + (text . "\tab{22} ") + (bcStrings (10 "6.21" y20 F)) + (text . "\tab{42} ") + (bcStrings (10 "10.25" z20 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "11.52" x21 F)) + (text . "\tab{22} ") + (bcStrings (10 "8.53" y21 F)) + (text . "\tab{42} ") + (bcStrings (10 "15.74" z21 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "15.20" x22 F)) + (text . "\tab{22} ") + (bcStrings (10 "0.0" y22 F)) + (text . "\tab{42} ") + (bcStrings (10 "21.60" z22 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "7.54" x23 F)) + (text . "\tab{22} ") + (bcStrings (10 "10.69" y23 F)) + (text . "\tab{42} ") + (bcStrings (10 "19.31" z23 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "17.32" x24 F)) + (text . "\tab{22} ") + (bcStrings (10 "13.78" y24 F)) + (text . "\tab{42} ") + (bcStrings (10 "12.11" z24 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "2.14" x25 F)) + (text . "\tab{22} ") + (bcStrings (10 "15.03" y25 F)) + (text . "\tab{42} ") + (bcStrings (10 "53.10" z25 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.51" x26 F)) + (text . "\tab{22} ") + (bcStrings (10 "8.37" y26 F)) + (text . "\tab{42} ") + (bcStrings (10 "49.43" z26 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "22.69" x27 F)) + (text . "\tab{22} ") + (bcStrings (10 "19.63" y27 F)) + (text . "\tab{42} ") + (bcStrings (10 "3.25" z27 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "5.47" x28 F)) + (text . "\tab{22} ") + (bcStrings (10 "17.13" y28 F)) + (text . "\tab{42} ") + (bcStrings (10 "28.63" z28 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "21.67" x29 F)) + (text . "\tab{22} ") + (bcStrings (10 "14.36" y29 F)) + (text . "\tab{42} ") + (bcStrings (10 "5.52" z29 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "3.31" x30 F)) + (text . "\tab{22} ") + (bcStrings (10 "0.33" y30 F)) + (text . "\tab{42} ") + (bcStrings (10 "44.08" z30 F)) + (text . "\blankline")) + htMakeDoneButton('"Continue",'e01sefGen) + htpSetProperty(page,'m,m) + htpSetProperty(page,'rnq,rnq) + htpSetProperty(page,'rnw,rnw) + htpSetProperty(page,'nq,nq) + htpSetProperty(page,'nw,nw) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +e01sefGen htPage == + m := htpProperty(htPage,'m) + rnw := htpProperty(htPage,'rnw) + rnq := htpProperty(htPage,'rnq) + nw := htpProperty(htPage,'nw) + nq := htpProperty(htPage,'nq) + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + while y repeat + right := STRCONC ((first y).1," ") + y := rest y + mid := STRCONC ((first y).1," ") + y := rest y + left := STRCONC ((first y).1," ") + y := rest y + xlist := [left,:xlist] + flist := [mid,:flist] + dlist := [right,:dlist] + xstring := bcwords2liststring xlist + fstring := bcwords2liststring flist + dstring := bcwords2liststring dlist + prefix := STRCONC('"e01sef(",STRINGIMAGE m,",[",xstring,"],[",fstring,"],[") + prefix := STRCONC(prefix,dstring,"],",STRINGIMAGE nw,", ",STRINGIMAGE nq) + prefix := STRCONC(prefix,", ",rnw,", ",rnq,", ",STRINGIMAGE ifail,")") + linkGen prefix diff --git a/src/interp/nag-e01.boot.pamphlet b/src/interp/nag-e01.boot.pamphlet deleted file mode 100644 index 0aa2f106..00000000 --- a/src/interp/nag-e01.boot.pamphlet +++ /dev/null @@ -1,1782 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp nag-e01.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. - -@ -<<*>>= -<> - -)package "BOOT" - -e01baf() == - htInitPage('"E01BAF - Interpolating functions, cubic spline interpolant, one variable", nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXe01baf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e01baf| '|NagInterpolationPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "Determines a cubic B-spline interpolant ") - (text . "\center{s(x) = \htbitmap{e01baf}} to the points ") - (text . "(\htbitmap{xiii}, \htbitmap{yi}), for i = 1,2,...,m. ") - (text . "\blankline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "Enter the number of data points, {\it m}:") - (text . "\newline\tab{2} ") - (bcStrings (5 7 m PI)) - (text . "\blankline") - (text . "\newline") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'e01bafSolve) - htShowPage() - -e01bafSolve htPage == - m := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) - objValUnwrap htpLabelSpadValue(htPage, 'm) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - m = '7 => e01bafDefaultSolve(htPage,ifail) - labelList := - "append"/[f(i) for i in 1..m] where f(i) == - prefix := ('"\newline \tab{2} ") - post := ('"\tab{32} ") - xnam := INTERN STRCONC ('"x",STRINGIMAGE i) - ynam := INTERN STRCONC ('"y",STRINGIMAGE i) - num := INTERN STRCONC (STRINGIMAGE (QUOTIENT(i,10)),".",STRINGIMAGE (REM(i,10))) - [['text,:prefix],['bcStrings,[10, num, xnam, 'F]], - ['text,:post],['bcStrings,[10, 0.0, ynam, 'F]]] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :labelList] - page := htInitPage("E01BAF - Interpolating functions, cubic spline interpolant, one variable",htpPropertyList htPage) - htSay '"\menuitemstyle{}\tab{2} Values of x: \tab{30} " - htSay '"\menuitemstyle{}\tab{32} Corresponding values of y: " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'e01bafGen) - htpSetProperty(page,'m,m) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -e01bafDefaultSolve (htPage, ifail) == - m := '7 - page := htInitPage('"E01BAF - Interpolating functions, cubic spline interpolant, one variable",htpPropertyList htPage) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Values of x: \tab{30} ") - (text . "\menuitemstyle{}\tab{32} Corresponding values of y: ") - (text . "\newline \tab{2}") - (bcStrings (10 "0.0" x1 F)) - (text . "\tab{32} ") - (bcStrings (10 "1.0000" y1 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.2" x2 F)) - (text . "\tab{32} ") - (bcStrings (10 "1.2214" y2 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.4" x3 F)) - (text . "\tab{32} ") - (bcStrings (10 "1.4918" y3 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.6" x4 F)) - (text . "\tab{32} ") - (bcStrings (10 "1.8221" y4 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.75" x5 F)) - (text . "\tab{32} ") - (bcStrings (10 "2.1170" y5 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.9" x6 F)) - (text . "\tab{32} ") - (bcStrings (10 "2.4596" y6 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "1.0" x7 F)) - (text . "\tab{32} ") - (bcStrings (10 "2.7183" y7 F)) - (text . "\blankline")) - htMakeDoneButton('"Continue",'e01bafGen) - htpSetProperty(page,'m,m) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -e01bafGen htPage == - m := htpProperty(htPage,'m) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - lck := m + 4 - lwrk := 6*m+16 - y := alist - while y repeat - right := STRCONC ((first y).1," ") - y := rest y - left := STRCONC ((first y).1," ") - y := rest y - reallist := [left,:reallist] - imaglist := [right,:imaglist] - realstring := bcwords2liststring reallist - imagstring := bcwords2liststring imaglist - pre := STRCONC ('"e01baf(",STRINGIMAGE m,",[",realstring,"],[",imagstring) - post := STRCONC ('"],",STRINGIMAGE lck,",",STRINGIMAGE lwrk,",") - linkGen STRCONC (pre,post,STRINGIMAGE ifail,")") - -e01bef() == - htInitPage('"E01BEF - Interpolating functions, monoticity preserving, piecewise cubic Hermite, one variable", nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXe01bef} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Brow[Cser operation page}{(|oPageFrom| '|e01bef| '|NagInterpolationPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "Determines derivative estimates defining a monoticity preserving") - (text . " piecewise cubic Hermite interpolant to the set of points ") - (text . "(\htbitmap{xr}, \htbitmap{fr}), ") - (text . "for r = 1,2,...,m. The interpolant, its derivative, and its ") - (text . "integral can be evaluated by calls to E01BFF, E01BGF or E01BHF. ") - (text . "\blankline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "Enter the number of data points {\it n} \htbitmap{great=} 2:") - (text . "\newline\tab{2} ") - (bcStrings (5 9 n PI)) - (text . "\blankline") - (text . "\newline") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'e01befSolve) - htShowPage() - -e01befSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - error = 'zero => '0 - '-1 - n = '9 => e01befDefaultSolve(htPage,ifail) - labelList := - "append"/[f(i) for i in 1..n] where f(i) == - prefix := ('"\newline \tab{2} ") - post := ('"\tab{32} ") - xnam := INTERN STRCONC ('"x",STRINGIMAGE i) - ynam := INTERN STRCONC ('"y",STRINGIMAGE i) - num := INTERN STRCONC (STRINGIMAGE (QUOTIENT(i,10)),".",STRINGIMAGE (REM(i,10))) - [['text,:prefix],['bcStrings,[10, num, xnam, 'F]], - ['text,:post],['bcStrings,[10, 0.0, ynam, 'F]]] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :labelList] - page := htInitPage("E01BEF - Interpolating functions, monoticity preserving, piecewise cubic Hermite, one variable",htpPropertyList htPage) - htSay '"\menuitemstyle{}\tab{2} Values of \space{1} " - htSay '"\htbitmap{xr}: \tab{30} " - htSay '"\menuitemstyle{}\tab{32} Values of \space{1} " - htSay '"\htbitmap{fr}: " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'e01befGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -e01befDefaultSolve (htPage, ifail) == - n := '9 - page := htInitPage('"E01BEF - Interpolating functions, monoticity preserving, piecewise cubic Hermite, one variable",htpPropertyList htPage) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Values of \space{1} ") - (text . "\htbitmap{xr}: \tab{30} ") - (text . "\menuitemstyle{}\tab{32} Values of \space{1} \htbitmap{fr}: ") - (text . "\newline \tab{2}") - (bcStrings (10 "7.99" x1 F)) - (text . "\tab{32} ") - (bcStrings (10 "0.00000e+0" y1 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "8.09" x2 F)) - (text . "\tab{32} ") - (bcStrings (10 "0.27643e-4" y2 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "8.19" x3 F)) - (text . "\tab{32} ") - (bcStrings (10 "0.43750e-1" y3 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "8.70" x4 F)) - (text . "\tab{32} ") - (bcStrings (10 "0.16918" y4 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "9.20" x5 F)) - (text . "\tab{32} ") - (bcStrings (10 "0.46943" y5 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "10.00" x6 F)) - (text . "\tab{32} ") - (bcStrings (10 "0.94374" y6 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "12.00" x7 F)) - (text . "\tab{32} ") - (bcStrings (10 "0.99864" y7 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "15.00" x8 F)) - (text . "\tab{32} ") - (bcStrings (10 "0.99992" y8 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "20.00" x9 F)) - (text . "\tab{32} ") - (bcStrings (10 "0.99999" y9 F)) - (text . "\blankline")) - htMakeDoneButton('"Continue",'e01befGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -e01befGen htPage == - n := htpProperty(htPage,'n) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - lck := n + 4 - lwrk := 6*n+16 - y := alist - while y repeat - right := STRCONC ((first y).1," ") - y := rest y - left := STRCONC ((first y).1," ") - y := rest y - reallist := [left,:reallist] - imaglist := [right,:imaglist] - realstring := bcwords2liststring reallist - imagstring := bcwords2liststring imaglist - linkGen STRCONC ('"e01bef(",STRINGIMAGE n,",[",realstring,"],[",imagstring,"],",STRINGIMAGE ifail,")") - - -e01bff() == - htInitPage('"E01BFF - Interpolated values, interpolant computed by E01BEF, function only, one variable", nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXe01bff} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e01bff| '|NagInterpolationPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "Evaluates the piecewise cubic Hermite interpolant computed ") - (text . "by E01BEF at the set of points \htbitmap{xiii}, ") - (text . "for i = 1,2,...,m. ") - (text . "\blankline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "Enter the number of data points {\em n}: ") - (text . "\newline\tab{2} ") - (bcStrings (5 9 n PI)) - (text . "\blankline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "Enter the number of evaluation points {\em m}: ") - (text . "\newline\tab{2} ") - (bcStrings (5 11 m PI)) - (text . "\blankline") - (text . "\newline") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'e01bffSolve) - htShowPage() - -e01bffSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - m := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) - objValUnwrap htpLabelSpadValue(htPage, 'm) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - (n = '9 and m = '11) => e01bffDefaultSolve(htPage,ifail) - labelList := - "append"/[f(i) for i in 1..n] where f(i) == - prefix := ('"\newline \tab{2} ") - middle := ('"\tab{22} ") - post := ('" \tab{42} ") - xnam := INTERN STRCONC ('"x",STRINGIMAGE i) - ynam := INTERN STRCONC ('"y",STRINGIMAGE i) - znam := INTERN STRCONC ('"z",STRINGIMAGE i) - num := INTERN STRCONC (STRINGIMAGE (QUOTIENT(i,10)),".",STRINGIMAGE (REM(i,10))) - [['text,:prefix],['bcStrings,[10, num, xnam, 'F]], - ['text,:middle],['bcStrings,[10, 0.0, ynam, 'F]], - ['text,:post],['bcStrings,[10, 0.0, znam, 'F]]] - pxwords := ('"\blankline \menuitemstyle{}\tab{2} Values of ") - pxwords := STRCONC(pxwords,'"array {\it Px}: \newline ") - pxwords := cons('text,pxwords) - pointList := - "append"/[g(j) for j in 1..m] where g(j) == - preamb := ('"\newline \tab{2} ") - pnam := INTERN STRCONC ('"px",STRINGIMAGE j) - [['text,:preamb],['bcStrings,[10, 0.0, pnam, 'F]]] - labelList := [:labelList,pxwords,:pointList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :labelList] - page := htInitPage("E01BFF - Interpolated values, interpolant computed by E01BEF, function only, one variable",htpPropertyList htPage) - htSay '"\menuitemstyle{}\tab{2} Values of \space{1} " - htSay '"\htbitmap{xr}: \tab{20} \menuitemstyle{}\tab{22} " - htSay '"Values of \space{1} \htbitmap{fr}: \tab{40}" - htSay '"\menuitemstyle{}\tab{42} Values of \space{1} " - htSay '"\htbitmap{dr}: " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'e01bffGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -e01bffDefaultSolve (htPage, ifail) == - n := '9 - m := '11 - page := htInitPage('"E01BFF - Interpolated values, interpolant computed by E01BEF, function only, one variable",htpPropertyList htPage) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Values of \space{1} ") - (text . "\htbitmap{xr}: \tab{20} \menuitemstyle{}\tab{22} ") - (text . "Values of \space{1} \htbitmap{fr}: \tab{40} ") - (text . "\menuitemstyle{}\tab{42} Values of \space{1} ") - (text . "\htbitmap{dr}: ") - (text . "\newline \tab{2}") - (bcStrings (10 "7.99" x1 F)) - (text . "\tab{22} ") - (bcStrings (10 "0.00000e+0" y1 F)) - (text . "\tab{42} ") - (bcStrings (10 "0.00000e+0" z1 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "8.09" x2 F)) - (text . "\tab{22} ") - (bcStrings (10 "0.27643e-4" y2 F)) - (text . "\tab{42} ") - (bcStrings (10 "5.52510e-4" z2 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "8.19" x3 F)) - (text . "\tab{22} ") - (bcStrings (10 "0.43750e-1" y3 F)) - (text . "\tab{42} ") - (bcStrings (10 "0.33587" z3 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "8.70" x4 F)) - (text . "\tab{22} ") - (bcStrings (10 "0.16918" y4 F)) - (text . "\tab{42} ") - (bcStrings (10 "0.34944" z4 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "9.20" x5 F)) - (text . "\tab{22} ") - (bcStrings (10 "0.46943" y5 F)) - (text . "\tab{42} ") - (bcStrings (10 "0.59696" z5 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "10.00" x6 F)) - (text . "\tab{22} ") - (bcStrings (10 "0.94374" y6 F)) - (text . "\tab{42} ") - (bcStrings (10 "6.03260e-2" z6 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "12.00" x7 F)) - (text . "\tab{22} ") - (bcStrings (10 "0.99864" y7 F)) - (text . "\tab{42} ") - (bcStrings (10 "8.98335e-4" z7 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "15.00" x8 F)) - (text . "\tab{22} ") - (bcStrings (10 "0.99992" y8 F)) - (text . "\tab{42} ") - (bcStrings (10 "2.93954e-5" z8 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "20.00" x9 F)) - (text . "\tab{22} ") - (bcStrings (10 "0.99999" y9 F)) - (text . "\tab{42} ") - (bcStrings (10 "0.00000" z9 F)) - (text . "\blankline") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Values of array {\it Px}: ") - (text . "\newline \tab{2} ") - (bcStrings (10 "7.99" px1 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "9.191" px2 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "10.392" px3 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "11.593" px4 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "12.794" px5 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "13.995" px6 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "15.196" px7 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "16.397" px8 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "17.598" px9 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "18.799" px10 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "20.0" px11 F)) - (text . "\blankline")) - htMakeDoneButton('"Continue",'e01bffGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -e01bffGen htPage == - n := htpProperty(htPage,'n) - m := htpProperty(htPage,'m) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - lck := n + 4 - lwrk := 6*n+16 - y := alist - for i in 1..m repeat - px := STRCONC ((first y).1," ") - y := rest y - pxlist := [px,:pxlist] - pxstring := bcwords2liststring pxlist - while y repeat - right := STRCONC ((first y).1," ") - y := rest y - mid := STRCONC ((first y).1," ") - y := rest y - left := STRCONC ((first y).1," ") - y := rest y - xlist := [left,:xlist] - flist := [mid,:flist] - dlist := [right,:dlist] - xstring := bcwords2liststring xlist - fstring := bcwords2liststring flist - dstring := bcwords2liststring dlist - prefix := STRCONC('"e01bff(",STRINGIMAGE n,",[",xstring,"],[",fstring) - prefix := STRCONC(prefix,"],[",dstring,"],",STRINGIMAGE m,",[",pxstring,"],") - prefix := STRCONC(prefix,STRINGIMAGE ifail,")") - linkGen prefix - -e01bgf() == - htInitPage('"E01BGF - Interpolated values, interpolant computed by E01BEF, function and 1st derivative, one variable", nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXe01bgf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e01bgf| '|NagInterpolationPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "Evaluates the piecewise cubic Hermite interpolant computed ") - (text . "by E01BEF and its 1st derivative at the set of points \space{1} ") - (text . "\htbitmap{xiii}, for i = 1,2,...,m. ") - (text . "\blankline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "Enter the number of data points {\em n}: ") - (text . "\newline\tab{2} ") - (bcStrings (5 9 n PI)) - (text . "\blankline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "Enter the number of evaluation points {\em m}: ") - (text . "\newline\tab{2} ") - (bcStrings (5 11 m PI)) - (text . "\blankline") - (text . "\newline") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'e01bgfSolve) - htShowPage() - -e01bgfSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - m := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) - objValUnwrap htpLabelSpadValue(htPage, 'm) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - (n = '9 and m = '11) => e01bgfDefaultSolve(htPage,ifail) - labelList := - "append"/[f(i) for i in 1..n] where f(i) == - prefix := ('"\newline \tab{2} ") - middle := ('"\tab{22} ") - post := ('" \tab{42} ") - xnam := INTERN STRCONC ('"x",STRINGIMAGE i) - ynam := INTERN STRCONC ('"y",STRINGIMAGE i) - znam := INTERN STRCONC ('"z",STRINGIMAGE i) - num := INTERN STRCONC (STRINGIMAGE (QUOTIENT(i,10)),".",STRINGIMAGE (REM(i,10))) - [['text,:prefix],['bcStrings,[10, num, xnam, 'F]], - ['text,:middle],['bcStrings,[10, 0.0, ynam, 'F]], - ['text,:post],['bcStrings,[10, 0.0, znam, 'F]]] - pxwords := ('"\blankline \menuitemstyle{}\tab{2} Values of ") - pxwords := STRCONC(pxwords,'"array {\it Px}: \newline ") - pxwords := cons('text,pxwords) - pointList := - "append"/[g(j) for j in 1..m] where g(j) == - preamb := ('"\newline \tab{2} ") - pnam := INTERN STRCONC ('"px",STRINGIMAGE j) - [['text,:preamb],['bcStrings,[10, 0.0, pnam, 'F]]] - labelList := [:labelList,pxwords,:pointList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :labelList] - page := htInitPage("E01BGF - Interpolated values, interpolant computed by E01BEF, function and 1st derivative, one variable",htpPropertyList htPage) - htSay '"\menuitemstyle{}\tab{2} Values of \space{1} " - htSay '"\htbitmap{xr}: \tab{20} \menuitemstyle{}\tab{22} " - htSay '"Values of \space{1} \htbitmap{fr}: \tab{40}" - htSay '"\menuitemstyle{}\tab{42} Values of \space{1} " - htSay '"\htbitmap{dr}: " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'e01bgfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -e01bgfDefaultSolve (htPage, ifail) == - n := '9 - m := '11 - page := htInitPage('"E01BGF - Interpolated values, interpolant computed by E01BEF, function and 1st derivative, one variable",htpPropertyList htPage) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\menuitemstyle{}\tab{2} Values of \space{1} ") - (text . "\htbitmap{xr}: \tab{20} \menuitemstyle{}\tab{22} ") - (text . "Values of \space{1} \htbitmap{fr}: \tab{40} ") - (text . "\menuitemstyle{}\tab{42} Values of \space{1} ") - (text . "\htbitmap{dr}: ") - (text . "\newline \tab{2}") - (bcStrings (10 "7.99" x1 F)) - (text . "\tab{22} ") - (bcStrings (10 "0.00000e+0" y1 F)) - (text . "\tab{42} ") - (bcStrings (10 "0.00000e+0" z1 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "8.09" x2 F)) - (text . "\tab{22} ") - (bcStrings (10 "0.27643e-4" y2 F)) - (text . "\tab{42} ") - (bcStrings (10 "5.52510e-4" z2 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "8.19" x3 F)) - (text . "\tab{22} ") - (bcStrings (10 "0.43750e-1" y3 F)) - (text . "\tab{42} ") - (bcStrings (10 "0.33587" z3 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "8.70" x4 F)) - (text . "\tab{22} ") - (bcStrings (10 "0.16918" y4 F)) - (text . "\tab{42} ") - (bcStrings (10 "0.34944" z4 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "9.20" x5 F)) - (text . "\tab{22} ") - (bcStrings (10 "0.46943" y5 F)) - (text . "\tab{42} ") - (bcStrings (10 "0.59696" z5 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "10.00" x6 F)) - (text . "\tab{22} ") - (bcStrings (10 "0.94374" y6 F)) - (text . "\tab{42} ") - (bcStrings (10 "6.03260e-2" z6 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "12.00" x7 F)) - (text . "\tab{22} ") - (bcStrings (10 "0.99864" y7 F)) - (text . "\tab{42} ") - (bcStrings (10 "8.98335e-4" z7 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "15.00" x8 F)) - (text . "\tab{22} ") - (bcStrings (10 "0.99992" y8 F)) - (text . "\tab{42} ") - (bcStrings (10 "2.93954e-5" z8 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "20.00" x9 F)) - (text . "\tab{22} ") - (bcStrings (10 "0.99999" y9 F)) - (text . "\tab{42} ") - (bcStrings (10 "0.00000" z9 F)) - (text . "\blankline") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Values of array {\it Px}: ") - (text . "\newline \tab{2} ") - (bcStrings (10 "7.99" px1 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "9.191" px2 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "10.392" px3 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "11.593" px4 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "12.794" px5 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "13.995" px6 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "15.196" px7 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "16.397" px8 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "17.598" px9 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "18.799" px10 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "20.0" px11 F)) - (text . "\blankline")) - htMakeDoneButton('"Continue",'e01bgfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -e01bgfGen htPage == - n := htpProperty(htPage,'n) - m := htpProperty(htPage,'m) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - lck := n + 4 - lwrk := 6*n+16 - y := alist - for i in 1..m repeat - px := STRCONC ((first y).1," ") - y := rest y - pxlist := [px,:pxlist] - pxstring := bcwords2liststring pxlist - while y repeat - right := STRCONC ((first y).1," ") - y := rest y - mid := STRCONC ((first y).1," ") - y := rest y - left := STRCONC ((first y).1," ") - y := rest y - xlist := [left,:xlist] - flist := [mid,:flist] - dlist := [right,:dlist] - xstring := bcwords2liststring xlist - fstring := bcwords2liststring flist - dstring := bcwords2liststring dlist - prefix := STRCONC('"e01bgf(",STRINGIMAGE n,",[",xstring,"],[",fstring) - prefix := STRCONC(prefix,"],[",dstring,"],",STRINGIMAGE m,",[",pxstring,"],") - prefix := STRCONC(prefix,STRINGIMAGE ifail,")") - linkGen prefix - -e01bhf() == - htInitPage('"E01BHF - Interpolated values, interpolant computed by E01BEF, definite integral, one variable", nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXe01bhf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e01bhf| '|NagInterpolationPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "Evaluates the definite integral of the piecewise cubic Hermite ") - (text . "interpolant computed by E01BEF over the interval [a,b]. ") - (text . "\blankline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "Enter the number of data points {\em n}: ") - (text . "\newline\tab{2} ") - (bcStrings (5 9 n PI)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") - (text . "\newline {\em Lower} bound {\it a}: ") - (text . "\tab{32} \menuitemstyle{}\tab{34} ") - (text . "{\em Upper} bound {\it b}:") - (text . "\newline\tab{2} ") - (bcStrings (20 "7.99" a F)) - (text . "\tab{34} ") - (bcStrings (20 "20.0" b EM)) - (text . "\blankline") - (text . "\newline") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'e01bhfSolve) - htShowPage() - -e01bhfSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - a := htpLabelInputString(htPage,'a) - b := htpLabelInputString(htPage,'b) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - n = '9 => e01bhfDefaultSolve(htPage,a,b,ifail) - labelList := - "append"/[f(i) for i in 1..n] where f(i) == - prefix := ('"\newline \tab{2} ") - middle := ('"\tab{22} ") - post := ('" \tab{42} ") - xnam := INTERN STRCONC ('"x",STRINGIMAGE i) - ynam := INTERN STRCONC ('"y",STRINGIMAGE i) - znam := INTERN STRCONC ('"z",STRINGIMAGE i) - num := INTERN STRCONC (STRINGIMAGE (QUOTIENT(i,10)),".",STRINGIMAGE (REM(i,10))) - [['text,:prefix],['bcStrings,[10, num, xnam, 'F]], - ['text,:middle],['bcStrings,[10, 0.0, ynam, 'F]], - ['text,:post],['bcStrings,[10, 0.0, znam, 'F]]] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :labelList] - page := htInitPage("E01BHF - Interpolated values, interpolant computed by E01BEF, definite integral, one variable",htpPropertyList htPage) - htSay '"\menuitemstyle{}\tab{2} Values of \space{1} " - htSay '"\htbitmap{xr}: \tab{20} \menuitemstyle{}\tab{22} " - htSay '"Values of \space{1} \htbitmap{fr}: \tab{40}" - htSay '"\menuitemstyle{}\tab{42} Values of \space{1} " - htSay '"\htbitmap{dr}: " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'e01bhfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'a,a) - htpSetProperty(page,'b,b) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -e01bhfDefaultSolve (htPage,a,b,ifail) == - n := '9 - page := htInitPage('"E01BHF - Interpolated values, interpolant computed by E01BEF, definite integral, one variable",htpPropertyList htPage) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\menuitemstyle{}\tab{2} Values of \space{1} ") - (text . "\htbitmap{xr}: \tab{20} \menuitemstyle{}\tab{22} ") - (text . "Values of \space{1} \htbitmap{fr}: \tab{40} ") - (text . "\menuitemstyle{}\tab{42} Values of \space{1} ") - (text . "\htbitmap{dr}: ") - (text . "\newline \tab{2}") - (bcStrings (10 "7.99" x1 F)) - (text . "\tab{22} ") - (bcStrings (10 "0.00000e+0" y1 F)) - (text . "\tab{42} ") - (bcStrings (10 "0.00000e+0" z1 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "8.09" x2 F)) - (text . "\tab{22} ") - (bcStrings (10 "0.27643e-4" y2 F)) - (text . "\tab{42} ") - (bcStrings (10 "5.52510e-4" z2 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "8.19" x3 F)) - (text . "\tab{22} ") - (bcStrings (10 "0.43750e-1" y3 F)) - (text . "\tab{42} ") - (bcStrings (10 "0.33587" z3 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "8.70" x4 F)) - (text . "\tab{22} ") - (bcStrings (10 "0.16918" y4 F)) - (text . "\tab{42} ") - (bcStrings (10 "0.34944" z4 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "9.20" x5 F)) - (text . "\tab{22} ") - (bcStrings (10 "0.46943" y5 F)) - (text . "\tab{42} ") - (bcStrings (10 "0.59696" z5 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "10.00" x6 F)) - (text . "\tab{22} ") - (bcStrings (10 "0.94374" y6 F)) - (text . "\tab{42} ") - (bcStrings (10 "6.03260e-2" z6 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "12.00" x7 F)) - (text . "\tab{22} ") - (bcStrings (10 "0.99864" y7 F)) - (text . "\tab{42} ") - (bcStrings (10 "8.98335e-4" z7 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "15.00" x8 F)) - (text . "\tab{22} ") - (bcStrings (10 "0.99992" y8 F)) - (text . "\tab{42} ") - (bcStrings (10 "2.93954e-5" z8 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "20.00" x9 F)) - (text . "\tab{22} ") - (bcStrings (10 "0.99999" y9 F)) - (text . "\tab{42} ") - (bcStrings (10 "0.00000" z9 F)) - (text . "\blankline")) - htMakeDoneButton('"Continue",'e01bhfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'a,a) - htpSetProperty(page,'b,b) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -e01bhfGen htPage == - n := htpProperty(htPage,'n) - a := htpProperty(htPage,'a) - b := htpProperty(htPage,'b) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - lck := n + 4 - lwrk := 6*n+16 - y := alist - while y repeat - right := STRCONC ((first y).1," ") - y := rest y - mid := STRCONC ((first y).1," ") - y := rest y - left := STRCONC ((first y).1," ") - y := rest y - xlist := [left,:xlist] - flist := [mid,:flist] - dlist := [right,:dlist] - xstring := bcwords2liststring xlist - fstring := bcwords2liststring flist - dstring := bcwords2liststring dlist - prefix := STRCONC('"e01bhf(",STRINGIMAGE n,",[",xstring,"],[",fstring,"],[") - prefix := STRCONC(prefix,dstring,"],",STRINGIMAGE a,",",STRINGIMAGE b,",",STRINGIMAGE ifail,")") - linkGen prefix - - -e01daf() == - htInitPage('"E01DAF - Interpolating functions, fitting bicubic spline, data on a rectangular grid", nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXe01daf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e01daf| '|NagInterpolationPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "Determines a bicubic spline surface interpolating the set of ") - (text . "data values (\htbitmap{xr}, \htbitmap{yr}, \htbitmap{fqr}) ") - (text . "given on a rectangular grid. The grid is defined by ") - (text . "\space{1} \htbitmap{mx} points along the x-axis and ") - (text . "\space{1} \htbitmap{my} points along the y-axis. The ") - (text . "spline has \space{1} \htbitmap{px} knots ") - (text . "\htbitmap{lamdai} and \space{1}\htbitmap{py}") - (text . " knots \htbitmap{mui} in the x- and y-directions ") - (text . "respectively, and is given in the B-spline representation ") - (text . "\center{s(x,y) = \htbitmap{e01daf1}} ") - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") - (text . "\newline The value \space{1} \htbitmap{mx}: ") - (text . "\tab{32} \menuitemstyle{}\tab{34} ") - (text . "The value \space{1} \htbitmap{my}:") - (text . "\newline\tab{2} ") - (bcStrings (6 7 mx PI)) - (text . "\tab{34} ") - (bcStrings (6 6 my PI)) - (text . "\blankline") - (text . "\newline") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'e01dafSolve) - htShowPage() - -e01dafSolve htPage == - mx := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'mx) - objValUnwrap htpLabelSpadValue(htPage, 'mx) - my := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'my) - objValUnwrap htpLabelSpadValue(htPage, 'my) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - (mx = '7 and my = '6) => e01dafDefaultSolve(htPage,ifail) - xList := - "append"/[f(i) for i in 1..mx] where f(i) == - xnam := INTERN STRCONC ('"x",STRINGIMAGE i) - [['bcStrings,[6, 0.0, xnam, 'F]]] - prefix := ('"\newline \menuitemstyle{}\tab{2} Values of X(1) to X(MX): \newline ") - xList := [['text,:prefix],:xList] - yList := - "append"/[g(i) for i in 1..my] where g(i) == - ynam := INTERN STRCONC ('"y",STRINGIMAGE i) - [['bcStrings,[6, 0.0, ynam, 'F]]] - prefix := ('"\blankline\menuitemstyle{}\tab{2}Values of Y(1) to Y(MY): \newline ") - yList := [['text,:prefix],:yList] - fList := - "append"/[h(j,my) for j in 1..mx] where h(j,my) == - tempList := - "append"/[k(j,m) for m in 1..my] where k(j,m) == - fnam := INTERN STRCONC ('"f",STRINGIMAGE j, STRINGIMAGE m) - [['bcStrings,[6, 0.0, fnam, 'F]]] - prefix := ('"\newline ") - tempList := [['text,:prefix],:tempList] - prefix := ('"\blankline \menuitemstyle{} \tab{2} Values of F(MX*MY) ") - prefix := STRCONC(prefix,'"(x down, y across): ") - fList := [['text,:prefix],:fList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :xList,:yList,:fList] - page := htInitPage("E01DAF - Interpolating functions, fitting bicubic spline, data on a rectanglar grid",htpPropertyList htPage) - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'e01dafGen) - htpSetProperty(page,'mx,mx) - htpSetProperty(page,'my,my) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -e01dafDefaultSolve (htPage,ifail) == - mx := '7 - my := '6 - page := htInitPage('"E01DAF - Interpolating functions, fitting bicubic spline, data on rectangular grid",htpPropertyList htPage) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\menuitemstyle{}\tab{2} Values of X(1) to X(MX): ") - (text . "\newline ") - (bcStrings (6 "1.00" x1 F)) - (bcStrings (6 "1.10" x2 F)) - (bcStrings (6 "1.30" x3 F)) - (bcStrings (6 "1.50" x4 F)) - (bcStrings (6 "1.60" x5 F)) - (bcStrings (6 "1.80" x6 F)) - (bcStrings (6 "2.00" x7 F)) - (text . "\blankline ") - (text . "\newline ") - (text ."\menuitemstyle{} \tab{2} Values of Y(1) to Y(MY): ") - (text . "\newline ") - (bcStrings (6 "0.00" y1 F)) - (bcStrings (6 "0.10" y2 F)) - (bcStrings (6 "0.40" y3 F)) - (bcStrings (6 "0.70" y4 F)) - (bcStrings (6 "0.90" y5 F)) - (bcStrings (6 "1.00" y6 F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} Values of F(MX*MY) (x down, y across): ") - (text . "\newline ") - (bcStrings (6 "1.00" z11 F)) - (bcStrings (6 "1.10" z21 F)) - (bcStrings (6 "1.40" z31 F)) - (bcStrings (6 "1.70" z41 F)) - (bcStrings (6 "1.90" z51 F)) - (bcStrings (6 "2.00" z61 F)) - (text . "\newline ") - (bcStrings (6 "1.21" z12 F)) - (bcStrings (6 "1.31" z22 F)) - (bcStrings (6 "1.61" z32 F)) - (bcStrings (6 "1.91" z42 F)) - (bcStrings (6 "2.11" z52 F)) - (bcStrings (6 "2.21" z62 F)) - (text . "\newline ") - (bcStrings (6 "1.69" z13 F)) - (bcStrings (6 "1.79" z23 F)) - (bcStrings (6 "2.09" z33 F)) - (bcStrings (6 "2.39" z43 F)) - (bcStrings (6 "2.59" z53 F)) - (bcStrings (6 "2.69" z63 F)) - (text . "\newline ") - (bcStrings (6 "2.25" z14 F)) - (bcStrings (6 "2.35" z24 F)) - (bcStrings (6 "2.65" z34 F)) - (bcStrings (6 "2.95" z44 F)) - (bcStrings (6 "3.15" z54 F)) - (bcStrings (6 "3.25" z64 F)) - (text . "\newline ") - (bcStrings (6 "2.56" z15 F)) - (bcStrings (6 "2.66" z25 F)) - (bcStrings (6 "2.96" z35 F)) - (bcStrings (6 "3.26" z45 F)) - (bcStrings (6 "3.46" z55 F)) - (bcStrings (6 "3.56" z65 F)) - (text . "\newline ") - (bcStrings (6 "3.24" z16 F)) - (bcStrings (6 "3.34" z26 F)) - (bcStrings (6 "3.64" z36 F)) - (bcStrings (6 "3.94" z46 F)) - (bcStrings (6 "4.14" z56 F)) - (bcStrings (6 "4.24" z66 F)) - (text . "\newline ") - (bcStrings (6 "4.00" z17 F)) - (bcStrings (6 "4.10" z27 F)) - (bcStrings (6 "4.40" z37 F)) - (bcStrings (6 "4.70" z47 F)) - (bcStrings (6 "4.90" z57 F)) - (bcStrings (6 "5.00" z67 F)) - (text . "\blankline")) - htMakeDoneButton('"Continue",'e01dafGen) - htpSetProperty(page,'mx,mx) - htpSetProperty(page,'my,my) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -e01dafGen htPage == - mx := htpProperty(htPage,'mx) - my := htpProperty(htPage,'my) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - while y repeat - right := STRCONC ((first y).1, " ") - y := rest y - xlist := [right,:xlist] - for i in 1..mx repeat - xmx := [:xmx,(first xlist)] - xlist := rest xlist - xstring := bcwords2liststring xmx - for i in 1..my repeat - ymy := [:ymy,(first xlist)] - xlist := rest xlist - ystring := bcwords2liststring ymy - fstring := bcwords2liststring xlist - prefix := STRCONC('"e01daf(",STRINGIMAGE mx,", ",STRINGIMAGE my,",[") - midd := STRCONC(xstring, "], [",ystring,"], [",fstring,"], ") - linkGen STRCONC(prefix,midd,STRINGIMAGE ifail,")") - -e01saf() == - htInitPage('"E01SAF - Interpolating functions, method of Renka and Cline, two variables", nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXe01saf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e01saf| '|NagInterpolationPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "Determines a \htbitmap{c1} piecewise polynomial ") - (text . "surface F(x,y) interpolating the set of scattered points ") - (text . "(\htbitmap{xr}, \htbitmap{yr}, \htbitmap{fqr}), ") - (text . "for r = 1,2,...,m, using a method of Renka and Cline. ") - (text . "The interpolant can be evaluated using E01SBF. ") - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} \newline ") - (text . "Number of data points {\em m} \htbitmap{great=} 3:") - (text . "\newline \tab{2} ") - (bcStrings (6 30 m PI)) - (text . "\blankline") - (text . "\newline") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'e01safSolve) - htShowPage() - -e01safSolve htPage == - m := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) - objValUnwrap htpLabelSpadValue(htPage, 'm) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - m = '30 => e01safDefaultSolve(htPage,ifail) - labelList := - "append"/[f(i) for i in 1..m] where f(i) == - prefix := ('"\newline \tab{2} ") - middle := ('"\tab{22} ") - post := ('" \tab{42} ") - xnam := INTERN STRCONC ('"x",STRINGIMAGE i) - ynam := INTERN STRCONC ('"y",STRINGIMAGE i) - znam := INTERN STRCONC ('"z",STRINGIMAGE i) - num := INTERN STRCONC (STRINGIMAGE (QUOTIENT(i,10)),".",STRINGIMAGE (REM(i,10))) - [['text,:prefix],['bcStrings,[10, num, xnam, 'F]], - ['text,:middle],['bcStrings,[10, 0.0, ynam, 'F]], - ['text,:post],['bcStrings,[10, 0.0, znam, 'F]]] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :labelList] - page := htInitPage("E01SAF - Interpolating functions, method of Renka and Cline,two variables",htpPropertyList htPage) - htSay '"\menuitemstyle{}\tab{2} Values of \space{1} " - htSay '"\htbitmap{xr}: \tab{20} \menuitemstyle{}\tab{22} " - htSay '"Values of \space{1} \htbitmap{fr}: \tab{40}" - htSay '"\menuitemstyle{}\tab{42} Values of \space{1} " - htSay '"\htbitmap{dr}: " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'e01safGen) - htpSetProperty(page,'m,m) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -e01safDefaultSolve (htPage, ifail) == - m := '30 - page := htInitPage('"E01SAF - Interpolating functions, method of Renka and Cline, two variables",htpPropertyList htPage) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\menuitemstyle{}\tab{2} Values of \space{1} ") - (text . "\htbitmap{xr}: \tab{20} \menuitemstyle{}\tab{22} ") - (text . "Values of \space{1} \htbitmap{fr}: \tab{40} ") - (text . "\menuitemstyle{}\tab{42} Values of \space{1} ") - (text . "\htbitmap{dr}: ") - (text . "\newline \tab{2}") - (bcStrings (10 "11.16" x1 F)) - (text . "\tab{22} ") - (bcStrings (10 "1.24" y1 F)) - (text . "\tab{42} ") - (bcStrings (10 "22.15" z1 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "12.85" x2 F)) - (text . "\tab{22} ") - (bcStrings (10 "3.06" y2 F)) - (text . "\tab{42} ") - (bcStrings (10 "22.11" z2 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "19.85" x3 F)) - (text . "\tab{22} ") - (bcStrings (10 "10.72" y3 F)) - (text . "\tab{42} ") - (bcStrings (10 "7.97" z3 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "19.72" x4 F)) - (text . "\tab{22} ") - (bcStrings (10 "1.39" y4 F)) - (text . "\tab{42} ") - (bcStrings (10 "16.83" z4 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "15.91" x5 F)) - (text . "\tab{22} ") - (bcStrings (10 "7.74" y5 F)) - (text . "\tab{42} ") - (bcStrings (10 "15.30" z5 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.00" x6 F)) - (text . "\tab{22} ") - (bcStrings (10 "20.00" y6 F)) - (text . "\tab{42} ") - (bcStrings (10 "34.60" z6 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "20.87" x7 F)) - (text . "\tab{22} ") - (bcStrings (10 "20.00" y7 F)) - (text . "\tab{42} ") - (bcStrings (10 "5.74" z7 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "3.45" x8 F)) - (text . "\tab{22} ") - (bcStrings (10 "12.78" y8 F)) - (text . "\tab{42} ") - (bcStrings (10 "41.24" z8 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "14.26" x9 F)) - (text . "\tab{22} ") - (bcStrings (10 "17.87" y9 F)) - (text . "\tab{42} ") - (bcStrings (10 "10.74" z9 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "17.43" x10 F)) - (text . "\tab{22} ") - (bcStrings (10 "3.46" y10 F)) - (text . "\tab{42} ") - (bcStrings (10 "18.60" z10 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "22.80" x11 F)) - (text . "\tab{22} ") - (bcStrings (10 "12.39" y11 F)) - (text . "\tab{42} ") - (bcStrings (10 "5.47" z11 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "7.58" x12 F)) - (text . "\tab{22} ") - (bcStrings (10 "1.98" y12 F)) - (text . "\tab{42} ") - (bcStrings (10 "29.87" z12 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "25.00" x13 F)) - (text . "\tab{22} ") - (bcStrings (10 "11.87" y13 F)) - (text . "\tab{42} ") - (bcStrings (10 "4.40" z13 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.00" x14 F)) - (text . "\tab{22} ") - (bcStrings (10 "0.00" y14 F)) - (text . "\tab{42} ") - (bcStrings (10 "58.20" z14 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "9.66" x15 F)) - (text . "\tab{22} ") - (bcStrings (10 "20.00" y15 F)) - (text . "\tab{42} ") - (bcStrings (10 "4.73" z15 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "5.22" x16 F)) - (text . "\tab{22} ") - (bcStrings (10 "14.66" y16 F)) - (text . "\tab{42} ") - (bcStrings (10 "40.36" z16 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "17.25" x17 F)) - (text . "\tab{22} ") - (bcStrings (10 "19.57" y17 F)) - (text . "\tab{42} ") - (bcStrings (10 "6.43" z17 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "25.00" x18 F)) - (text . "\tab{22} ") - (bcStrings (10 "3.87" y18 F)) - (text . "\tab{42} ") - (bcStrings (10 "8.74" z18 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "12.13" x19 F)) - (text . "\tab{22} ") - (bcStrings (10 "10.79" y19 F)) - (text . "\tab{42} ") - (bcStrings (10 "13.71" z19 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "22.23" x20 F)) - (text . "\tab{22} ") - (bcStrings (10 "6.21" y20 F)) - (text . "\tab{42} ") - (bcStrings (10 "10.25" z20 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "11.52" x21 F)) - (text . "\tab{22} ") - (bcStrings (10 "8.53" y21 F)) - (text . "\tab{42} ") - (bcStrings (10 "15.74" z21 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "15.20" x22 F)) - (text . "\tab{22} ") - (bcStrings (10 "0.0" y22 F)) - (text . "\tab{42} ") - (bcStrings (10 "21.60" z22 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "7.54" x23 F)) - (text . "\tab{22} ") - (bcStrings (10 "10.69" y23 F)) - (text . "\tab{42} ") - (bcStrings (10 "19.31" z23 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "17.32" x24 F)) - (text . "\tab{22} ") - (bcStrings (10 "13.78" y24 F)) - (text . "\tab{42} ") - (bcStrings (10 "12.11" z24 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "2.14" x25 F)) - (text . "\tab{22} ") - (bcStrings (10 "15.03" y25 F)) - (text . "\tab{42} ") - (bcStrings (10 "53.10" z25 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.51" x26 F)) - (text . "\tab{22} ") - (bcStrings (10 "8.37" y26 F)) - (text . "\tab{42} ") - (bcStrings (10 "49.43" z26 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "22.69" x27 F)) - (text . "\tab{22} ") - (bcStrings (10 "19.63" y27 F)) - (text . "\tab{42} ") - (bcStrings (10 "3.25" z27 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "5.47" x28 F)) - (text . "\tab{22} ") - (bcStrings (10 "17.13" y28 F)) - (text . "\tab{42} ") - (bcStrings (10 "28.63" z28 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "21.67" x29 F)) - (text . "\tab{22} ") - (bcStrings (10 "14.36" y29 F)) - (text . "\tab{42} ") - (bcStrings (10 "5.52" z29 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "3.31" x30 F)) - (text . "\tab{22} ") - (bcStrings (10 "0.33" y30 F)) - (text . "\tab{42} ") - (bcStrings (10 "44.08" z30 F)) - (text . "\blankline")) - htMakeDoneButton('"Continue",'e01safGen) - htpSetProperty(page,'m,m) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -e01safGen htPage == - m := htpProperty(htPage,'m) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - while y repeat - right := STRCONC ((first y).1," ") - y := rest y - mid := STRCONC ((first y).1," ") - y := rest y - left := STRCONC ((first y).1," ") - y := rest y - xlist := [left,:xlist] - flist := [mid,:flist] - dlist := [right,:dlist] - xstring := bcwords2liststring xlist - fstring := bcwords2liststring flist - dstring := bcwords2liststring dlist - prefix := STRCONC('"e01saf(",STRINGIMAGE m,",[",xstring,"],[",fstring,"],[") - prefix := STRCONC(prefix,dstring,"],",STRINGIMAGE ifail,")") - linkGen prefix - -e01sef() == - htInitPage('"E01SEF - Interpolating functions, modified Shepard's method, two variables", nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXe01sef} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e01sef| '|NagInterpolationPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "Determines a \htbitmap{c1} piecewise polynomial ") - (text . "surface F(x,y) interpolating the set of scattered points ") - (text . "(\htbitmap{xr}, \htbitmap{yr}, \htbitmap{fqr}), ") - (text . "for r = 1,2,...,m, using a modified Shepard method. ") - (text . "The interpolant can be evaluated using E01SFF. ") - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} \newline ") - (text . "Number of data points {\em m} \htbitmap{great=} 3:") - (text . "\newline \tab{2} ") - (bcStrings (6 30 m PI)) - (text . "\blankline ") - (text . "Note: RNW, RNQ, NW, NQ set to zero for default value. ") - (text . "On exit, they contain the value actually used. ") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "\newline {\em RNW} weight locality radius: ") - (text . "\tab{32} \menuitemstyle{}\tab{34}") - (text . "{\em RNQ} point locality radius:") - (text . "\newline\tab{2} ") - (bcStrings (6 "0.0" rnw F)) - (text . "\tab{34} ") - (bcStrings (6 "0.0" rnq F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} \newline") - (text . "{\em NW} average number of points within RNW of each point: ") - (text . "\newline \tab{2} ") - (bcStrings (6 0 nw I)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} \newline") - (text . "{\em NQ} average number of points within RNQ of each point: ") - (text . "\newline \tab{2} ") - (bcStrings (6 0 nq I)) - (text . "\blankline") - (text . "\newline") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'e01sefSolve) - htShowPage() - -e01sefSolve htPage == - m := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) - objValUnwrap htpLabelSpadValue(htPage, 'm) - nw := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nw) - objValUnwrap htpLabelSpadValue(htPage, 'nw) - nq := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nq) - objValUnwrap htpLabelSpadValue(htPage, 'nq) - rnq := htpLabelInputString(htPage,'rnq) - rnw := htpLabelInputString(htPage,'rnw) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - m = '30 => e01sefDefaultSolve(htPage,rnq,rnw,nq,nw,ifail) - labelList := - "append"/[f(i) for i in 1..m] where f(i) == - prefix := ('"\newline \tab{2} ") - middle := ('"\tab{22} ") - post := ('" \tab{42} ") - xnam := INTERN STRCONC ('"x",STRINGIMAGE i) - ynam := INTERN STRCONC ('"y",STRINGIMAGE i) - znam := INTERN STRCONC ('"z",STRINGIMAGE i) - num := INTERN STRCONC (STRINGIMAGE (QUOTIENT(i,10)),".",STRINGIMAGE (REM(i,10))) - [['text,:prefix],['bcStrings,[10, num, xnam, 'F]], - ['text,:middle],['bcStrings,[10, 0.0, ynam, 'F]], - ['text,:post],['bcStrings,[10, 0.0, znam, 'F]]] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :labelList] - page := htInitPage("E01SEF - Interpolating functions, modified Shepard's method, two variables",htpPropertyList htPage) - htSay '"\menuitemstyle{}\tab{2} Values of \space{1} " - htSay '"\htbitmap{xr}: \tab{20} \menuitemstyle{}\tab{22} " - htSay '"Values of \space{1} \htbitmap{fr}: \tab{40}" - htSay '"\menuitemstyle{}\tab{42} Values of \space{1} " - htSay '"\htbitmap{dr}: " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'e01sefGen) - htpSetProperty(page,'m,m) - htpSetProperty(page,'rnq,rnq) - htpSetProperty(page,'rnw,rnw) - htpSetProperty(page,'nq,nq) - htpSetProperty(page,'nw,nw) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -e01sefDefaultSolve (htPage,rnq,rnw,nq,nw,ifail) == - m := '30 - page := htInitPage('"E01SEF - Interpolating functions, modified Shepard's method, two variables",htpPropertyList htPage) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\menuitemstyle{}\tab{2} Values of \space{1} ") - (text . "\htbitmap{xr}: \tab{20} \menuitemstyle{}\tab{22} ") - (text . "Values of \space{1} \htbitmap{fr}: \tab{40} ") - (text . "\menuitemstyle{}\tab{42} Values of \space{1} ") - (text . "\htbitmap{dr}: ") - (text . "\newline \tab{2}") - (bcStrings (10 "11.16" x1 F)) - (text . "\tab{22} ") - (bcStrings (10 "1.24" y1 F)) - (text . "\tab{42} ") - (bcStrings (10 "22.15" z1 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "12.85" x2 F)) - (text . "\tab{22} ") - (bcStrings (10 "3.06" y2 F)) - (text . "\tab{42} ") - (bcStrings (10 "22.11" z2 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "19.85" x3 F)) - (text . "\tab{22} ") - (bcStrings (10 "10.72" y3 F)) - (text . "\tab{42} ") - (bcStrings (10 "7.97" z3 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "19.72" x4 F)) - (text . "\tab{22} ") - (bcStrings (10 "1.39" y4 F)) - (text . "\tab{42} ") - (bcStrings (10 "16.83" z4 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "15.91" x5 F)) - (text . "\tab{22} ") - (bcStrings (10 "7.74" y5 F)) - (text . "\tab{42} ") - (bcStrings (10 "15.30" z5 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.00" x6 F)) - (text . "\tab{22} ") - (bcStrings (10 "20.00" y6 F)) - (text . "\tab{42} ") - (bcStrings (10 "34.60" z6 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "20.87" x7 F)) - (text . "\tab{22} ") - (bcStrings (10 "20.00" y7 F)) - (text . "\tab{42} ") - (bcStrings (10 "5.74" z7 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "3.45" x8 F)) - (text . "\tab{22} ") - (bcStrings (10 "12.78" y8 F)) - (text . "\tab{42} ") - (bcStrings (10 "41.24" z8 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "14.26" x9 F)) - (text . "\tab{22} ") - (bcStrings (10 "17.87" y9 F)) - (text . "\tab{42} ") - (bcStrings (10 "10.74" z9 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "17.43" x10 F)) - (text . "\tab{22} ") - (bcStrings (10 "3.46" y10 F)) - (text . "\tab{42} ") - (bcStrings (10 "18.60" z10 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "22.80" x11 F)) - (text . "\tab{22} ") - (bcStrings (10 "12.39" y11 F)) - (text . "\tab{42} ") - (bcStrings (10 "5.47" z11 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "7.58" x12 F)) - (text . "\tab{22} ") - (bcStrings (10 "1.98" y12 F)) - (text . "\tab{42} ") - (bcStrings (10 "29.87" z12 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "25.00" x13 F)) - (text . "\tab{22} ") - (bcStrings (10 "11.87" y13 F)) - (text . "\tab{42} ") - (bcStrings (10 "4.40" z13 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.00" x14 F)) - (text . "\tab{22} ") - (bcStrings (10 "0.00" y14 F)) - (text . "\tab{42} ") - (bcStrings (10 "58.20" z14 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "9.66" x15 F)) - (text . "\tab{22} ") - (bcStrings (10 "20.00" y15 F)) - (text . "\tab{42} ") - (bcStrings (10 "4.73" z15 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "5.22" x16 F)) - (text . "\tab{22} ") - (bcStrings (10 "14.66" y16 F)) - (text . "\tab{42} ") - (bcStrings (10 "40.36" z16 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "17.25" x17 F)) - (text . "\tab{22} ") - (bcStrings (10 "19.57" y17 F)) - (text . "\tab{42} ") - (bcStrings (10 "6.43" z17 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "25.00" x18 F)) - (text . "\tab{22} ") - (bcStrings (10 "3.87" y18 F)) - (text . "\tab{42} ") - (bcStrings (10 "8.74" z18 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "12.13" x19 F)) - (text . "\tab{22} ") - (bcStrings (10 "10.79" y19 F)) - (text . "\tab{42} ") - (bcStrings (10 "13.71" z19 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "22.23" x20 F)) - (text . "\tab{22} ") - (bcStrings (10 "6.21" y20 F)) - (text . "\tab{42} ") - (bcStrings (10 "10.25" z20 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "11.52" x21 F)) - (text . "\tab{22} ") - (bcStrings (10 "8.53" y21 F)) - (text . "\tab{42} ") - (bcStrings (10 "15.74" z21 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "15.20" x22 F)) - (text . "\tab{22} ") - (bcStrings (10 "0.0" y22 F)) - (text . "\tab{42} ") - (bcStrings (10 "21.60" z22 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "7.54" x23 F)) - (text . "\tab{22} ") - (bcStrings (10 "10.69" y23 F)) - (text . "\tab{42} ") - (bcStrings (10 "19.31" z23 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "17.32" x24 F)) - (text . "\tab{22} ") - (bcStrings (10 "13.78" y24 F)) - (text . "\tab{42} ") - (bcStrings (10 "12.11" z24 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "2.14" x25 F)) - (text . "\tab{22} ") - (bcStrings (10 "15.03" y25 F)) - (text . "\tab{42} ") - (bcStrings (10 "53.10" z25 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.51" x26 F)) - (text . "\tab{22} ") - (bcStrings (10 "8.37" y26 F)) - (text . "\tab{42} ") - (bcStrings (10 "49.43" z26 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "22.69" x27 F)) - (text . "\tab{22} ") - (bcStrings (10 "19.63" y27 F)) - (text . "\tab{42} ") - (bcStrings (10 "3.25" z27 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "5.47" x28 F)) - (text . "\tab{22} ") - (bcStrings (10 "17.13" y28 F)) - (text . "\tab{42} ") - (bcStrings (10 "28.63" z28 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "21.67" x29 F)) - (text . "\tab{22} ") - (bcStrings (10 "14.36" y29 F)) - (text . "\tab{42} ") - (bcStrings (10 "5.52" z29 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "3.31" x30 F)) - (text . "\tab{22} ") - (bcStrings (10 "0.33" y30 F)) - (text . "\tab{42} ") - (bcStrings (10 "44.08" z30 F)) - (text . "\blankline")) - htMakeDoneButton('"Continue",'e01sefGen) - htpSetProperty(page,'m,m) - htpSetProperty(page,'rnq,rnq) - htpSetProperty(page,'rnw,rnw) - htpSetProperty(page,'nq,nq) - htpSetProperty(page,'nw,nw) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -e01sefGen htPage == - m := htpProperty(htPage,'m) - rnw := htpProperty(htPage,'rnw) - rnq := htpProperty(htPage,'rnq) - nw := htpProperty(htPage,'nw) - nq := htpProperty(htPage,'nq) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - while y repeat - right := STRCONC ((first y).1," ") - y := rest y - mid := STRCONC ((first y).1," ") - y := rest y - left := STRCONC ((first y).1," ") - y := rest y - xlist := [left,:xlist] - flist := [mid,:flist] - dlist := [right,:dlist] - xstring := bcwords2liststring xlist - fstring := bcwords2liststring flist - dstring := bcwords2liststring dlist - prefix := STRCONC('"e01sef(",STRINGIMAGE m,",[",xstring,"],[",fstring,"],[") - prefix := STRCONC(prefix,dstring,"],",STRINGIMAGE nw,", ",STRINGIMAGE nq) - prefix := STRCONC(prefix,", ",rnw,", ",rnq,", ",STRINGIMAGE ifail,")") - linkGen prefix -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/nag-e02.boot b/src/interp/nag-e02.boot new file mode 100644 index 00000000..56588e73 --- /dev/null +++ b/src/interp/nag-e02.boot @@ -0,0 +1,4673 @@ +-- 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. + + +)package "BOOT" + +e02adf() == + htInitPage('"E02ADF - Least-squares curve fit, by polynomials, arbitrary data points", nil) + htMakePage '( + (domainConditions + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXe02adf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02adf| '|NagFittingPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "Determines weighted least-squares polynomial approximations of ") + (text . "degrees 0,1,...,k to the set of points {\it (} ") + (text . "\htbitmap{xr}, \htbitmap{yr}{\it )} ") + (text . "with weights \htbitmap{wr}, for r = 1,2,...,m. ") + (text . "The polynomials are in the Chebyshev series form, the ") + (text . "approximation of degree {\it i} being represented as ") + (text . "\newline \center{\htbitmap{e02adf}} , where ") + (text . "\htbitmap{xbar} is the normalised argument, which is ") + (text . "related to the original variable {\it x} by the transformation ") + (text . "\blankline \center{\htbitmap{e02adf1}} ") + (text . ",\htbitmap{xmin} and \htbitmap{xmax} being ") + (text . "the values of \htbitmap{xr} respectively ") + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} \newline ") + (text . "Number of data points {\it m}:") + (text . "\newline \tab{2} ") + (bcStrings (6 11 m PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Maximum degree required {\it k}:") + (text . "\newline \tab{2} ") + (bcStrings (6 3 k PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} \newline ") + (text . "First dimension of A, {\it nrows} \htbitmap{great=} {\it k+1}: ") + (text . "\newline \tab{2} ") + (bcStrings (6 50 nrows I)) + (text . "\blankline") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Ifail value: ") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'e02adfSolve) + htShowPage() + +e02adfSolve htPage == + m := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) + objValUnwrap htpLabelSpadValue(htPage, 'm) + k := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'k) + objValUnwrap htpLabelSpadValue(htPage, 'k) + nrows := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nrows) + objValUnwrap htpLabelSpadValue(htPage, 'nrows) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + (m = '11 and k ='3) => e02adfDefaultSolve(htPage,k,nrows,ifail) + labelList := + "append"/[f(i) for i in 1..m] where f(i) == + prefix := ('"\newline \tab{2} ") + middle := ('"\tab{22} ") + post := ('" \tab{42} ") + xnam := INTERN STRCONC ('"x",STRINGIMAGE i) + ynam := INTERN STRCONC ('"y",STRINGIMAGE i) + znam := INTERN STRCONC ('"z",STRINGIMAGE i) + num := INTERN STRCONC (STRINGIMAGE (QUOTIENT(i,10)),".",STRINGIMAGE (REM(i,10))) + [['text,:prefix],['bcStrings,[10, num, xnam, 'F]], + ['text,:middle],['bcStrings,[10, 0.0, ynam, 'F]], + ['text,:post],['bcStrings,[10, 0.0, znam, 'F]]] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :labelList] + page := htInitPage("E02ADF - Least-squares curve fit, by polynomials, arbitrary data points", htpPropertyList htPage) + htSay '"\menuitemstyle{}\tab{2} Values of \space{1} " + htSay '"\htbitmap{xr}: \tab{20} \menuitemstyle{}\tab{22} " + htSay '"Values of \space{1} \htbitmap{fr}: \tab{40}" + htSay '"\menuitemstyle{}\tab{42} Values of \space{1} " + htSay '"\htbitmap{dr}: " + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'e02adfGen) + htpSetProperty(page,'m,m) + htpSetProperty(page,'k,k) + htpSetProperty(page,'nrows,nrows) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +e02adfDefaultSolve (htPage,k,nrows,ifail) == + m := '11 + page := htInitPage('"E02ADF - Least-squares curve fit, by polynomials, arbitrary data points", htpPropertyList htPage) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Values of \space{1} ") + (text . "\htbitmap{xr}: \tab{20} \menuitemstyle{}\tab{22} ") + (text . "Values of \space{1} \htbitmap{yr}: \tab{40} ") + (text . "\menuitemstyle{}\tab{42} Values of \space{1} ") + (text . "\htbitmap{wr}: ") + (text . "\newline \tab{2}") + (bcStrings (10 "1.00" x1 F)) + (text . "\tab{22} ") + (bcStrings (10 "10.40" y1 F)) + (text . "\tab{42} ") + (bcStrings (10 "1.00" z1 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "2.10" x2 F)) + (text . "\tab{22} ") + (bcStrings (10 "7.90" y2 F)) + (text . "\tab{42} ") + (bcStrings (10 "1.00" z2 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "3.10" x3 F)) + (text . "\tab{22} ") + (bcStrings (10 "4.70" y3 F)) + (text . "\tab{42} ") + (bcStrings (10 "1.00" z3 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "3.90" x4 F)) + (text . "\tab{22} ") + (bcStrings (10 "2.50" y4 F)) + (text . "\tab{42} ") + (bcStrings (10 "1.00" z4 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "4.90" x5 F)) + (text . "\tab{22} ") + (bcStrings (10 "1.20" y5 F)) + (text . "\tab{42} ") + (bcStrings (10 "1.00" z5 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "5.80" x6 F)) + (text . "\tab{22} ") + (bcStrings (10 "2.20" y6 F)) + (text . "\tab{42} ") + (bcStrings (10 "0.80" z6 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "6.50" x7 F)) + (text . "\tab{22} ") + (bcStrings (10 "5.10" y7 F)) + (text . "\tab{42} ") + (bcStrings (10 "0.80" z7 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "7.10" x8 F)) + (text . "\tab{22} ") + (bcStrings (10 "9.20" y8 F)) + (text . "\tab{42} ") + (bcStrings (10 "0.70" z8 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "7.80" x9 F)) + (text . "\tab{22} ") + (bcStrings (10 "16.10" y9 F)) + (text . "\tab{42} ") + (bcStrings (10 "0.50" z9 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "8.40" x10 F)) + (text . "\tab{22} ") + (bcStrings (10 "24.50" y10 F)) + (text . "\tab{42} ") + (bcStrings (10 "0.30" z10 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "9.00" x11 F)) + (text . "\tab{22} ") + (bcStrings (10 "35.30" y11 F)) + (text . "\tab{42} ") + (bcStrings (10 "0.20" z11 F)) + (text . "\blankline")) + htMakeDoneButton('"Continue",'e02adfGen) + htpSetProperty(page,'m,m) + htpSetProperty(page,'k,k) + htpSetProperty(page,'nrows,nrows) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +e02adfGen htPage == + m := htpProperty(htPage,'m) + k := htpProperty(htPage,'k) + nrows := htpProperty(htPage,'nrows) + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + kplus1 := k + 1 + y := alist + while y repeat + right := STRCONC ((first y).1," ") + y := rest y + mid := STRCONC ((first y).1," ") + y := rest y + left := STRCONC ((first y).1," ") + y := rest y + xlist := [left,:xlist] + ylist := [mid,:ylist] + wlist := [right,:wlist] + xstring := bcwords2liststring xlist + ystring := bcwords2liststring ylist + wstring := bcwords2liststring wlist + prefix := STRCONC('"e02adf(",STRINGIMAGE m,", ",STRINGIMAGE kplus1,", ") + prefix := STRCONC(prefix,STRINGIMAGE nrows,", [",xstring,"],[",ystring,"],[") + prefix := STRCONC(prefix,wstring,"],",STRINGIMAGE ifail,")") + linkGen prefix + +e02aef() == + htInitPage('"E02AEF - Evaluation of fitted polynomial in one variable from Chebyshev series form", nil) + htMakePage '( + (domainConditions + (isDomain F (Float)) + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXe02aef} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02aef| '|NagFittingPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "Evaluates a polynomial in Chabyshev series representation ") + (text . "\newline \center{\htbitmap{e02aef}} ") + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} \newline ") + (text . "Number of terms in the series {\it n}:") + (text . "\newline \tab{2} ") + (bcStrings (6 4 n PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "\htbitmap{xbar}: ") + (text . " \newline \tab{2} ") + (bcStrings (6 "-1.0" xcap F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Ifail value: ") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'e02aefSolve) + htShowPage() + +e02aefSolve htPage == + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + xcap := htpLabelInputString(htPage,'xcap) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + n = '4 => e02aefDefaultSolve(htPage,xcap,ifail) + labelList := + "append"/[f(i) for i in 1..(n+1)] where f(i) == + prefix := ('"\newline \tab{15} ") + anam := INTERN STRCONC ('"a",STRINGIMAGE i) + [['text,:prefix],['bcStrings,[10, 0.0, anam, 'F]]] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :labelList] + page := htInitPage("E02AEF - Evaluation of fitted polynomial in one variable from Chebyshev series from", nil) + htSay '"\menuitemstyle{}\tab{2} Enter the coefficients of {\it a(n+1)}:" + htSay '"\blankline " + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'e02aefGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'xcap,xcap) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +e02aefDefaultSolve (htPage,xcap,ifail) == + n := '4 + page := htInitPage('"E02AEF - Evaluation of fitted polynomial in one variable from Chebyshev series form", nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Enter the coeffients of {\it a(n+1)}: ") + (text . "\blankline ") + (text . "\newline \tab{15} ") + (bcStrings (10 "2.0000" a1 F)) + (text . "\newline \tab{15} ") + (bcStrings (10 "0.5000" a2 F)) + (text . "\newline \tab{15} ") + (bcStrings (10 "0.2500" a3 F)) + (text . "\newline \tab{15} ") + (bcStrings (10 "0.1250" a4 F)) + (text . "\newline \tab{15} ") + (bcStrings (10 "0.0625" a5 F)) + (text . "\blankline ")) + htMakeDoneButton('"Continue",'e02aefGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'xcap,xcap) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +e02aefGen htPage == + n := htpProperty(htPage,'n) + xcap := htpProperty(htPage,'xcap) + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + nplus1 := n + 1 + y := alist + while y repeat + right := STRCONC ((first y).1," ") + y := rest y + arrayList := [right,:arrayList] + astring := bcwords2liststring arrayList + prefix := STRCONC('"e02aef(",STRINGIMAGE nplus1,", [",astring ,"], ") + prefix := STRCONC(prefix,STRINGIMAGE xcap,", ",STRINGIMAGE ifail,")") + linkGen prefix + +e02agf() == + htInitPage('"E02AGF - Least-squares polynomial fit, values and derivatives may be constrained, arbitrary data values",nil) + htMakePage '( + (domainConditions + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXe02agf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02agf| '|NagFittingPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "Determines constrained least-squares polynomial approximations ") + (text . "to the set of points {\it (\htbitmap{xr},\htbitmap{yr})} with ") + (text . "weights \htbitmap{wr}, for r = 1,2,...,m. The values of the ") + (text . "approximations and any number of their derivatives must be ") + (text . "specified at a further set of points \htbitmap{xii}, ") + (text . "for i = 1,2,...,{\it mf}. The total number of interpolating ") + (text . "conditions is given by \center{\htbitmap{e02agf}} where ") + (text . "\htbitmap{pi} is the highest order derivative ") + (text . "specified at point \htbitmap{xii}. The values ") + (text . "\htbitmap{xr} and \htbitmap{xii} all lie ") + (text . "in the interval [\htbitmap{xmin},") + (text . "\htbitmap{xmax}]. The polynomials are given in ") + (text . "Chebyshev series form, the approximation of degree {\it i} being") + (text . " represented as\blankline \center{\htbitmap{e02agf1}}") + (text . "\newline, where \htbitmap{xbar} is the normalised ") + (text . "argument, related to the original variable {\it x} by the ") + (text . "transformation \newline \center{\htbitmap{e02adf1}} ") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "\newline Number of data points {\it m}:") + (text . "\tab{32} \menuitemstyle{}\tab{34}") + (text . "Maximum degree required {\it k}:") + (text . "\newline\tab{2} ") + (bcStrings (6 5 m PI)) + (text . "\tab{34} ") + (bcStrings (6 4 k PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} \newline ") + (text . "First dimension of A, {\it nrows \htbitmap{great=} k+1}: ") + (text . "\newline \tab{2} ") + (bcStrings (6 6 nrows I)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "\newline \htbitmap{xmin}: ") + (text . "\tab{32} \menuitemstyle{}\tab{34}") + (text . "\htbitmap{xmax}: ") + (text . "\newline\tab{2} ") + (bcStrings (6 "0.0" xmin F)) + (text . "\tab{34} ") + (bcStrings (6 "4.0" xmax F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "\newline Dimension of {\it xf} & {\it ip}, {\it mf}: ") + (text . "\tab{32} \menuitemstyle{}\tab{34}") + (text . "Dimension of {\it yf}, {\it lyf}:") + (text . "\newline\tab{2} ") + (bcStrings (6 2 mf PI)) + (text . "\tab{34} ") + (bcStrings (6 15 lyf PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Ifail value: ") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'e02agfSolve) + htShowPage() + +e02agfSolve htPage == + m := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) + objValUnwrap htpLabelSpadValue(htPage, 'm) + k := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'k) + objValUnwrap htpLabelSpadValue(htPage, 'kplus1) + nrows := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nrows) + objValUnwrap htpLabelSpadValue(htPage, 'nrows) + xmin := htpLabelInputString(htPage,'xmin) + xmax := htpLabelInputString(htPage,'xmax) + mf := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'mf) + objValUnwrap htpLabelSpadValue(htPage, 'mf) + lyf := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lyf) + objValUnwrap htpLabelSpadValue(htPage, 'lyf) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + (m = '5 and k ='4 and mf = '2 and lyf = '15) => e02agfDefaultSolve(htPage,nrows,xmin,xmax,ifail) + labelList := + "append"/[f(i) for i in 1..m] where f(i) == + prefix := ('"\newline \tab{2} ") + middle := ('"\tab{22} ") + post := ('" \tab{42} ") + xnam := INTERN STRCONC ('"x",STRINGIMAGE i) + ynam := INTERN STRCONC ('"y",STRINGIMAGE i) + znam := INTERN STRCONC ('"z",STRINGIMAGE i) + num := INTERN STRCONC (STRINGIMAGE (QUOTIENT(i,10)),".",STRINGIMAGE (REM(i,10))) + [['text,:prefix],['bcStrings,[10, num, xnam, 'F]], + ['text,:middle],['bcStrings,[10, 0.0, ynam, 'F]], + ['text,:post],['bcStrings,[10, 0.0, znam, 'F]]] + xfList := + "append"/[g(j) for j in 1..mf] where g(j) == + xfnam := INTERN STRCONC ('"xf",STRINGIMAGE j) + [['bcStrings,[6, 0.0, xfnam, 'F]]] + prefix := ('"\blankline \newline \menuitemstyle{}\tab{2} Values of ") + prefix := STRCONC(prefix,"{\it xf}: \newline \tab{2} ") + xfList := [['text,:prefix],:xfList] + ipList := + "append"/[h(k) for k in 1..mf] where h(k) == + ipnam := INTERN STRCONC ('"ip",STRINGIMAGE k) + [['bcStrings,[6, 0, ipnam, 'PI]]] + prefix := ('"\blankline \newline \menuitemstyle{}\tab{2} Values of ") + prefix := STRCONC(prefix,"{\it ip}: \newline \tab{2} ") + ipList := [['text,:prefix],:ipList] + yfList := + "append"/[i(l) for l in 1..lyf] where i(l) == + prefix := ('"\newline \tab{2} ") + yfnam := INTERN STRCONC ('"lyf",STRINGIMAGE l) + [['text,:prefix],['bcStrings,[10, 0.0, yfnam, 'F]]] + prefix := ('"\blankline \newline \menuitemstyle{}\tab{2} Values of ") + prefix := STRCONC(prefix,"{\it yf}: \newline \tab{2} ") + yfList := [['text,:prefix],:yfList] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :labelList,:xfList,:ipList,:yfList] + page := htInitPage("E02AGF - Least-squares polynomial fit, values and derivatives may be constrained, arbitrary data values",nil) + htSay '"\menuitemstyle{}\tab{2} Values of \space{1} " + htSay '"\htbitmap{xr}: \tab{20} \menuitemstyle{}\tab{22} " + htSay '"Values of \space{1} \htbitmap{yr}: \tab{40}" + htSay '"\menuitemstyle{}\tab{42} Values of \space{1} " + htSay '"\htbitmap{wr}: " + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'e02agfGen) + htpSetProperty(page,'m,m) + htpSetProperty(page,'k,k) + htpSetProperty(page,'nrows,nrows) + htpSetProperty(page,'nrows,nrows) + htpSetProperty(page,'xmin,xmin) + htpSetProperty(page,'xmax,xmax) + htpSetProperty(page,'mf,mf) + htpSetProperty(page,'lyf,lyf) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +e02agfDefaultSolve (htPage,nrows,xmin,xmax,ifail) == + m := '5 + k := '4 + mf := '2 + lyf := '15 + page := htInitPage('"E02AGF - Least-squares polynomial fit, values and derivativesby polynomials, arbitrary data points", htpPropertyList htPage) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\menuitemstyle{}\tab{2} Values of \space{1} ") + (text . "\htbitmap{xr}: \tab{20} \menuitemstyle{}\tab{22} ") + (text . "Values of \space{1} \htbitmap{yr}: \tab{40} ") + (text . "\menuitemstyle{}\tab{42} Values of \space{1} ") + (text . "\htbitmap{wr}: ") + (text . "\newline \tab{2}") + (bcStrings (10 "0.5" x1 F)) + (text . "\tab{22} ") + (bcStrings (10 "0.03" y1 F)) + (text . "\tab{42} ") + (bcStrings (10 "1.0" z1 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "1.0" x2 F)) + (text . "\tab{22} ") + (bcStrings (10 "-0.75" y2 F)) + (text . "\tab{42} ") + (bcStrings (10 "1.0" z2 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "2.0" x3 F)) + (text . "\tab{22} ") + (bcStrings (10 "-1.0" y3 F)) + (text . "\tab{42} ") + (bcStrings (10 "1.0" z3 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "2.5" x4 F)) + (text . "\tab{22} ") + (bcStrings (10 "-0.1" y4 F)) + (text . "\tab{42} ") + (bcStrings (10 "1.0" z4 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "3.0" x5 F)) + (text . "\tab{22} ") + (bcStrings (10 "1.75" y5 F)) + (text . "\tab{42} ") + (bcStrings (10 "1.0" z5 F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Values of {\it xf}: ") + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" xf1 F)) + (bcStrings (6 "4.0" xf2 F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Values of {\it ip}: ") + (text . "\newline \tab{2} ") + (bcStrings (6 1 ip1 PI)) + (bcStrings (6 0 ip2 PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Values of {\it yf}: ") + (text . "\newline \tab{2} ") + (bcStrings (10 "1.0" lyf1 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "-2.0" lyf2 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "9.0" lyf3 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.0" lyf4 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.0" lyf5 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.0" lyf6 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.0" lyf7 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.0" lyf8 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.0" lyf9 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.0" lyf10 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.0" lyf11 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.0" lyf12 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.0" lyf13 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.0" lyf14 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.0" lyf15 F))) + htMakeDoneButton('"Continue",'e02agfGen) + htpSetProperty(page,'m,m) + htpSetProperty(page,'k,k) + htpSetProperty(page,'nrows,nrows) + htpSetProperty(page,'xmin,xmin) + htpSetProperty(page,'xmax,xmax) + htpSetProperty(page,'mf,mf) + htpSetProperty(page,'lyf,lyf) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +e02agfGen htPage == + m := htpProperty(htPage,'m) + k := htpProperty(htPage,'k) + nrows := htpProperty(htPage,'nrows) + xmin := htpProperty(htPage,'xmin) + xmax := htpProperty(htPage,'xmax) + mf := htpProperty(htPage,'mf) + lyf := htpProperty(htPage,'lyf) + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + kplus1 := k + 1 + ipsum := 0 + y := alist + for i in 1..lyf repeat + yf := STRCONC((first y).1," ") + yfList := [yf,:yfList] + y := rest y + yfstring := bcwords2liststring yfList + for i in 1..mf repeat + iptest := (first y).1 + iptestval := READ_-FROM_-STRING(iptest) + ipsum := ipsum + iptestval + ip := STRCONC(iptest," ") + iptestList := [iptestval,:iptestList] + ipList := [ip,:ipList] + y := rest y + ipstring := bcwords2liststring ipList + ipmax := APPLY ('MAX, iptestList) + n := mf + ipsum + for i in 1..mf repeat + xf := STRCONC((first y).1," ") + xfList := [xf,:xfList] + y := rest y + xfstring := bcwords2liststring xfList + while y repeat + right := STRCONC ((first y).1," ") + y := rest y + mid := STRCONC ((first y).1," ") + y := rest y + left := STRCONC ((first y).1," ") + y := rest y + xlist := [left,:xlist] + ylist := [mid,:ylist] + wlist := [right,:wlist] + xstring := bcwords2liststring xlist + ystring := bcwords2liststring ylist + wstring := bcwords2liststring wlist + wrktest1 := 4*m + 3*kplus1 + wrktest2 := 8*n + 5*ipmax + mf +10 + wrktestlist := [wrktest1,wrktest2] + wrkmax := APPLY ('MAX, wrktestlist) + lwrk := wrkmax + 2*n + 2 + liwrk := 2*mf + 2 + prefix := STRCONC('"e02agf(",STRINGIMAGE m,", ",STRINGIMAGE kplus1,", ") + prefix := STRCONC(prefix,STRINGIMAGE nrows,", ",xmin,", ",xmax,", [",xstring) + prefix := STRCONC(prefix,"],[",ystring,"],[",wstring,"],",STRINGIMAGE mf) + prefix := STRCONC(prefix,", [",xfstring,"],[",yfstring,"],") + prefix := STRCONC(prefix,STRINGIMAGE lyf,", [",ipstring,"]::Matrix Integer,") + prefix := STRCONC(prefix,STRINGIMAGE lwrk,", ",STRINGIMAGE liwrk,", ") + prefix := STRCONC(prefix,STRINGIMAGE ifail,")") + linkGen prefix + +e02ahf() == + htInitPage('"E02AHF - Derivative of fitted polynomial in Chebyshev series",nil) + htMakePage '( + (domainConditions + (isDomain F (Float)) + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXe02ahf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02ahf| '|NagFittingPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "Determines the indefinite integral of the Chebyshev series ") + (text . "representation \newline \center{\htbitmap{e02ahf1}} ") + (text . "of a polynomial, where \htbitmap{xbar} is the ") + (text . "normalised argument, related to the original variable x by the ") + (text . "transformation \blankline \center{\htbitmap{e02adf1}}") + (text . ",\htbitmap{xmin} and \htbitmap{xmax} being ") + (text . "minimum and maximum values of {\it x} respectively. The integral") + (text . " polynomial has the form ") + (text . "\blankline \center{\htbitmap{e02ahf}}") + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} \newline ") + (text . "Degree of the polynomial {\it n}:") + (text . "\newline \tab{2} ") + (bcStrings (6 6 n PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "\newline \htbitmap{xmin}: ") + (text . "\tab{32} \menuitemstyle{}\tab{34}") + (text . "\htbitmap{xmax}: ") + (text . "\newline\tab{2} ") + (bcStrings (6 "-0.5" xmin F)) + (text . "\tab{34} ") + (bcStrings (6 "2.5" xmax F)) +-- (text . "\blankline ") +-- (text . "\newline ") +-- (text . "\menuitemstyle{}\tab{2}") +-- (text . "\newline Dimension of array {\it a}, {\it la}: ") +-- (text . "\tab{32} \menuitemstyle{}\tab{34}") +-- (text . "Dimension of {\it adif}, {\it ladif}: ") +-- (text . "\newline\tab{2} ") +-- (bcStrings (6 7 la PI)) +-- (text . "\tab{34} ") +-- (bcStrings (6 7 ladif PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "\newline Increment of array {\it a}, {\it ia1}: ") + (text . "\tab{32} \menuitemstyle{}\tab{34}") + (text . "\newline Increment of array {\it adif}, {\it ladif1}: ") + (text . "\newline\tab{2} ") + (bcStrings (6 1 iaone PI)) + (text . "\tab{34} ") + (bcStrings (6 1 ladifone PI)) + (text . "\blankline") + (text . "\newline \menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Ifail value: ") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'e02ahfSolve) + htShowPage() + +e02ahfSolve htPage == + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + xmin := htpLabelInputString(htPage,'xmin) + xmax := htpLabelInputString(htPage,'xmax) + iaone := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iaone) + objValUnwrap htpLabelSpadValue(htPage, 'iaone) + ladifone := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ladifone) + objValUnwrap htpLabelSpadValue(htPage, 'ladifone) + la := 1+n*iaone +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'la) +-- objValUnwrap htpLabelSpadValue(htPage, 'la) + ladif :=1+n*ladifone +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ladif) +-- objValUnwrap htpLabelSpadValue(htPage, 'ladif) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + (n = '6 and (la ='7 and ladif = '7)) => + e02ahfDefaultSolve(htPage,xmin,xmax,iaone,ladifone,ifail) + labelList := + "append"/[f(i) for i in 1..la] where f(i) == + prefix := ('"\newline \tab{15} ") + anam := INTERN STRCONC ('"a",STRINGIMAGE i) + [['text,:prefix],['bcStrings,[10, "0.0000", anam, 'F]]] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :labelList] + page := htInitPage("E02AHF - Derivative of fitted polynomial in Chebyshev series",nil) + htSay '"\menuitemstyle{}\tab{2} Coefficients of {\it a(la)}:" + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'e02ahfGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'la,la) + htpSetProperty(page,'ladif,ladif) + htpSetProperty(page,'xmin,xmin) + htpSetProperty(page,'xmax,xmax) + htpSetProperty(page,'iaone,iaone) + htpSetProperty(page,'ladifone,ladifone) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +e02ahfDefaultSolve (htPage,xmin,xmax,iaone,ladifone,ifail) == + n := '6 + la := '7 + ladif := '7 + page := htInitPage('"E02AHF - Derivative of fitted polynomial in Chebyshev series",nil) + htMakePage '( + (domainConditions + (isDomain PI (Positive Integer)) + (isDomain F (Float))) + (text . "\menuitemstyle{}\tab{2} ") + (text . "Coefficients of {\it a(la)}: ") + (text . "\newline \tab{15}") + (bcStrings (10 "2.53213" a1 F)) + (text . "\newline \tab{15}") + (bcStrings (10 "1.13032" a2 F)) + (text . "\newline \tab{15}") + (bcStrings (10 "0.27150" a3 F)) + (text . "\newline \tab{15}") + (bcStrings (10 "0.04434" a4 F)) + (text . "\newline \tab{15}") + (bcStrings (10 "0.00547" a5 F)) + (text . "\newline \tab{15}") + (bcStrings (10 "0.00054" a6 F)) + (text . "\newline \tab{15}") + (bcStrings (10 "0.00004" a7 F)) + (text . "\blankline")) + htMakeDoneButton('"Continue",'e02ahfGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'la,la) + htpSetProperty(page,'ladif,ladif) + htpSetProperty(page,'xmin,xmin) + htpSetProperty(page,'xmax,xmax) + htpSetProperty(page,'iaone,iaone) + htpSetProperty(page,'ladifone,ladifone) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +e02ahfGen htPage == + n := htpProperty(htPage,'n) + la := htpProperty(htPage,'la) + ladif := htpProperty(htPage,'ladif) + xmin := htpProperty(htPage,'xmin) + xmax := htpProperty(htPage,'xmax) + iaone := htpProperty(htPage,'iaone) + ladifone := htpProperty(htPage,'ladifone) + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + np1 := n + 1 + y := alist + while y repeat + right := STRCONC ((first y).1," ") + y := rest y + arrayList := [right,:arrayList] + astring := bcwords2liststring arrayList + prefix := STRCONC('"e02ahf(",STRINGIMAGE np1,", ",xmin,", ",xmax,", [") + prefix := STRCONC(prefix,astring,"], ",STRINGIMAGE iaone,", ") + prefix := STRCONC(prefix,STRINGIMAGE la,", ",STRINGIMAGE ladifone,", ") + prefix := STRCONC(prefix,STRINGIMAGE ladif,", ",STRINGIMAGE ifail,")") + linkGen prefix + +e02ajf() == + htInitPage('"E02AJF - Integral of fitted polynomial in Chebyshev series form",nil) + htMakePage '( + (domainConditions + (isDomain F (Float)) + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXe02ajf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02ajf| '|NagFittingPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "Determines the indefinite integral of the Chebyshev series ") + (text . "representation \newline \center{\htbitmap{e02ahf1}} ") + (text . "of a polynomial, where \htbitmap{xbar} is the normalis") + (text . "ed argument, related to the original variable {\it x} by the ") + (text . "transformation \blankline \center{\htbitmap{e02adf1}}") + (text . ",\htbitmap{xmin} and \htbitmap{xmax} being ") + (text . "minimum and maximum values of {\it x} respectively. The integral") + (text . " polynomial has the form ") + (text . "\blankline \center{\htbitmap{e02ajf}}") + (text . "and the integration is with respect to the original variable ") + (text . "{\it x} \blankline ") + (text . "\newline \menuitemstyle{}\tab{2} \newline ") + (text . "Degree of the polynomial {\it n}:") + (text . "\newline \tab{2} ") + (bcStrings (6 6 n PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "\newline \htbitmap{xmin}: ") + (text . "\tab{32} \menuitemstyle{}\tab{34}") + (text . "\htbitmap{xmax}: ") + (text . "\newline\tab{2} ") + (bcStrings (6 "-0.5" xmin F)) + (text . "\tab{34} ") + (bcStrings (6 "2.5" xmax F)) +-- (text . "\blankline ") +-- (text . "\newline ") +-- (text . "\menuitemstyle{}\tab{2}") +-- (text . "\newline Dimension of array {\it a}, {\it la}: ") +-- (text . "\tab{32} \menuitemstyle{}\tab{34}") +-- (text . "Dimension of {\it aint}, {\it laint}: ") +-- (text . "\newline\tab{2} ") +-- (bcStrings (6 7 la PI)) +-- (text . "\tab{34} ") +-- (bcStrings (6 8 laint PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "\newline Index increment of {\it a}, {\it ia1}: ") + (text . "\tab{32} \menuitemstyle{}\tab{34}") + (text . "Increment of {\it aint}, {\it iaint1}: ") + (text . "\newline \tab{2} ") + (bcStrings (6 1 iaone PI)) + (text . "\tab{34} ") + (bcStrings (6 1 iaintone PI)) + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} \newline ") + (text . "Constant of integration {\it qatm1}: ") + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" qatmone F)) + (text . "\blankline") + (text . "\newline \menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Ifail value: ") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'e02ajfSolve) + htShowPage() + +e02ajfSolve htPage == + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + xmin := htpLabelInputString(htPage,'xmin) + xmax := htpLabelInputString(htPage,'xmax) + iaone := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iaone) + objValUnwrap htpLabelSpadValue(htPage, 'iaone) + iaintone := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iaintone) + objValUnwrap htpLabelSpadValue(htPage, 'iaintone) + la := 1+n*iaone +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'la) +-- objValUnwrap htpLabelSpadValue(htPage, 'la) + laint := n*iaintone + 1 + qatmone := htpLabelInputString(htPage,'qatmone) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + (n = '6 and (la ='7 and laint = '7)) => + e02ajfDefaultSolve(htPage,xmin,xmax,iaone,iaintone,qatmone,ifail) + labelList := + "append"/[f(i) for i in 1..la] where f(i) == + prefix := ('"\newline \tab{15} ") + anam := INTERN STRCONC ('"a",STRINGIMAGE i) + [['text,:prefix],['bcStrings,[10, "0.0000", anam, 'F]]] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :labelList] + page := htInitPage("E02AJF - Integral of fitted polynomial in Chebyshev series form",nil) + htSay '"\menuitemstyle{}\tab{2} Coefficients of {\it a(la)}: " + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'e02ajfGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'la,la) + htpSetProperty(page,'laint,laint) + htpSetProperty(page,'xmin,xmin) + htpSetProperty(page,'xmax,xmax) + htpSetProperty(page,'iaone,iaone) + htpSetProperty(page,'iaintone,iaintone) + htpSetProperty(page,'qatmone,qatmone) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +e02ajfDefaultSolve (htPage,xmin,xmax,iaone,iaintone,qatmone,ifail) == + n := '6 + la := '7 + laint := '8 + page := htInitPage('"E02AJF - Integral of fitted polynomial in Chebyshev series form",nil) + htMakePage '( + (domainConditions + (isDomain PI (Positive Integer)) + (isDomain F (Float))) + (text . "\menuitemstyle{}\tab{2} ") + (text . "Coefficients of {\it a(la)}: ") + (text . "\newline \tab{15}") + (bcStrings (10 "2.53213" a1 F)) + (text . "\newline \tab{15}") + (bcStrings (10 "1.13032" a2 F)) + (text . "\newline \tab{15}") + (bcStrings (10 "0.27150" a3 F)) + (text . "\newline \tab{15}") + (bcStrings (10 "0.04434" a4 F)) + (text . "\newline \tab{15}") + (bcStrings (10 "0.00547" a5 F)) + (text . "\newline \tab{15}") + (bcStrings (10 "0.00054" a6 F)) + (text . "\newline \tab{15}") + (bcStrings (10 "0.00004" a7 F)) + (text . "\blankline")) + htMakeDoneButton('"Continue",'e02ajfGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'la,la) + htpSetProperty(page,'laint,laint) + htpSetProperty(page,'xmin,xmin) + htpSetProperty(page,'xmax,xmax) + htpSetProperty(page,'iaone,iaone) + htpSetProperty(page,'iaintone,iaintone) + htpSetProperty(page,'qatmone,qatmone) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +e02ajfGen htPage == + n := htpProperty(htPage,'n) + la := htpProperty(htPage,'la) + laint := htpProperty(htPage,'laint) + xmin := htpProperty(htPage,'xmin) + xmax := htpProperty(htPage,'xmax) + iaone := htpProperty(htPage,'iaone) + iaintone := htpProperty(htPage,'iaintone) + qatmone := htpProperty(htPage,'qatmone) + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + np1 := n + 1 + y := alist + while y repeat + right := STRCONC ((first y).1," ") + y := rest y + arrayList := [right,:arrayList] + astring := bcwords2liststring arrayList + prefix := STRCONC('"e02ajf(",STRINGIMAGE np1,", ",xmin,", ",xmax,", [") + prefix := STRCONC(prefix,astring,"], ",STRINGIMAGE iaone,", ") + prefix := STRCONC(prefix,STRINGIMAGE la,", ",qatmone,", ") + prefix := STRCONC(prefix,STRINGIMAGE iaintone) + prefix := STRCONC(prefix,", ",STRINGIMAGE laint,", ",STRINGIMAGE ifail,")") + linkGen prefix + +e02akf() == + htInitPage('"E02AKF - Evaluation of fitted polynomial in one variable, from Chebyshev series form",nil) + htMakePage '( + (domainConditions + (isDomain F (Float)) + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXe02akf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02akf| '|NagFittingPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "Evaluates at the point x the Chebyshev series representation ") + (text . "representation \newline \center{\htbitmap{e02ahf1}} ") + (text . "of a polynomial, where \htbitmap{xbar} is the normalis") + (text . "ed argument, related to the original variable {\it x} by the ") + (text . "transformation \blankline \center{\htbitmap{e02adf1}}") + (text . ",\htbitmap{xmin} and \htbitmap{xmax} being ") + (text . "minimum and maximum values of {\it x} respectively. ") + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} \newline ") + (text . "Degree of the polynomial {\it n}:") + (text . "\tab{32} \menuitemstyle{}\tab{34}") + (text . "Evaluation point {\it x}: ") + (text . "\newline \tab{2} ") + (bcStrings (6 6 n PI)) + (text . "\tab{34} ") + (bcStrings (6 "-0.5" x F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "\newline \htbitmap{xmin}: ") + (text . "\tab{32} \menuitemstyle{}\tab{34}") + (text . "\htbitmap{xmax}: ") + (text . "\newline\tab{2} ") + (bcStrings (6 "-0.5" xmin F)) + (text . "\tab{34} ") + (bcStrings (6 "2.5" xmax F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") +-- (text . "\newline Dimension of array {\it a}, {\it la} : ") +-- (text . "\tab{32} \menuitemstyle{}\tab{34}") + (text . "Index increment of {\it a}, {\it ia1}: ") + (text . "\newline\tab{2} ") +-- (bcStrings (6 7 la PI)) +-- (text . "\tab{34} ") + (bcStrings (6 1 iaone PI)) + (text . "\blankline") + (text . "\newline \menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Ifail value: ") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'e02akfSolve) + htShowPage() + +e02akfSolve htPage == + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + x := htpLabelInputString(htPage,'x) + xmin := htpLabelInputString(htPage,'xmin) + xmax := htpLabelInputString(htPage,'xmax) + iaone := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iaone) + objValUnwrap htpLabelSpadValue(htPage, 'iaone) + la := 1+n*iaone +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'la) +-- objValUnwrap htpLabelSpadValue(htPage, 'la) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + (n = '6 and la ='7) => e02akfDefaultSolve(htPage,xmin,xmax,x,iaone,ifail) + labelList := + "append"/[f(i) for i in 1..la] where f(i) == + prefix := ('"\newline \tab{15} ") + anam := INTERN STRCONC ('"a",STRINGIMAGE i) + [['text,:prefix],['bcStrings,[10, "0.0000", anam, 'F]]] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :labelList] + page := htInitPage("E02AKF - Evaluation of fitted polynomial in one variable, from Chebyshev series form",nil) + htSay '"\menuitemstyle{}\tab{2} Coefficients of {\it a(la)}:" + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'e02akfGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'x,x) + htpSetProperty(page,'la,la) + htpSetProperty(page,'xmin,xmin) + htpSetProperty(page,'xmax,xmax) + htpSetProperty(page,'iaone,iaone) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +e02akfDefaultSolve (htPage,xmin,xmax,x,iaone,ifail) == + n := '6 + la := '7 + page := htInitPage('"E02AKF - Evaluation of fitted polynomial in one variable, from Chebyshev series form",nil) + htMakePage '( + (domainConditions + (isDomain PI (Positive Integer)) + (isDomain F (Float))) + (text . "\menuitemstyle{}\tab{2} ") + (text . "Coefficients of {\it a(la)}: ") + (text . "\newline \tab{15}") + (bcStrings (10 "2.53213" a1 F)) + (text . "\newline \tab{15}") + (bcStrings (10 "1.13032" a2 F)) + (text . "\newline \tab{15}") + (bcStrings (10 "0.27150" a3 F)) + (text . "\newline \tab{15}") + (bcStrings (10 "0.04434" a4 F)) + (text . "\newline \tab{15}") + (bcStrings (10 "0.00547" a5 F)) + (text . "\newline \tab{15}") + (bcStrings (10 "0.00054" a6 F)) + (text . "\newline \tab{15}") + (bcStrings (10 "0.00004" a7 F)) + (text . "\blankline")) + htMakeDoneButton('"Continue",'e02akfGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'la,la) + htpSetProperty(page,'x,x) + htpSetProperty(page,'xmin,xmin) + htpSetProperty(page,'xmax,xmax) + htpSetProperty(page,'iaone,iaone) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +e02akfGen htPage == + n := htpProperty(htPage,'n) + x := htpProperty(htPage,'x) + la := htpProperty(htPage,'la) + xmin := htpProperty(htPage,'xmin) + xmax := htpProperty(htPage,'xmax) + iaone := htpProperty(htPage,'iaone) + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + np1 := n + 1 + y := alist + while y repeat + right := STRCONC ((first y).1," ") + y := rest y + arrayList := [right,:arrayList] + astring := bcwords2liststring arrayList + prefix := STRCONC('"e02akf(",STRINGIMAGE np1,", ",xmin,", ",xmax,", [") + prefix := STRCONC(prefix,astring,"], ",STRINGIMAGE iaone,", ") + prefix := STRCONC(prefix,STRINGIMAGE la,", ",x,", ",STRINGIMAGE ifail,")") + linkGen prefix + + +e02baf() == + htInitPage('"E02BAF - Least-squares curve cubic spine fit",nil) + htMakePage '( + (domainConditions + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXe02baf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02baf| '|NagFittingPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "Determines a least-squares cubic spline approximation to the ") + (text . "set of points {\it (}\htbitmap{xr},") + (text . "\htbitmap{yr}{\it )} with weights ") + (text . "\htbitmap{wr}, for r = 1,2,...,m. ") + (text . "The knots \htbitmap{lamdai}, for i = 1,2,...,") + (text . "\htbitmap{ncap}+7, are prescribed by the user. The ") + (text . "spline is given by the B-spline representation \blankline ") + (text . "\center{\htbitmap{e02baf}} where ") + (text . "\htbitmap{ncap} is the number of intervals of the ") + (text . "spline. \blankline ") + (text . "\newline \menuitemstyle{}\tab{2} \newline ") + (text . "Number of data points {\it m}:") + (text . "\newline \tab{2} ") + (bcStrings (6 14 m PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Number of intervals in the spline \htbitmap{ncap}: ") + (text . "\newline\tab{2} ") + (bcStrings (6 5 ncap PI)) + (text . "\blankline") + (text . "\newline") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Ifail value: ") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'e02bafSolve) + htShowPage() + +e02bafSolve htPage == + m := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) + objValUnwrap htpLabelSpadValue(htPage, 'm) + ncap := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ncap) + objValUnwrap htpLabelSpadValue(htPage, 'ncap) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + (m = '14 and ncap ='5) => e02bafDefaultSolve(htPage,ifail) + labelList := + "append"/[f(i) for i in 1..m] where f(i) == + prefix := ('"\newline \tab{2} ") + middle := ('"\tab{22} ") + post := ('" \tab{42} ") + xnam := INTERN STRCONC ('"x",STRINGIMAGE i) + ynam := INTERN STRCONC ('"y",STRINGIMAGE i) + znam := INTERN STRCONC ('"z",STRINGIMAGE i) + num := INTERN STRCONC (STRINGIMAGE (QUOTIENT(i,10)),".",STRINGIMAGE (REM(i,10))) + [['text,:prefix],['bcStrings,[10, num, xnam, 'F]], + ['text,:middle],['bcStrings,[10, 0.0, ynam, 'F]], + ['text,:post],['bcStrings,[10, 0.0, znam, 'F]]] + lamdaList := + "append"/[g(j) for j in 5..(ncap+3)] where g(j) == + anam := INTERN STRCONC ('"a",STRINGIMAGE j) + [['bcStrings,[6, 0.0, anam, 'F]]] + prefix := ('"\blankline \menuitemstyle{}\tab{2} Interior knots ") + prefix := STRCONC(prefix,"\htbitmap{lamdai}, for i = 5,6,...,") + prefix := STRCONC(prefix,"\htbitmap{ncap} + 3: \newline \tab{2}" ) + lamdaList := [['text,:prefix],:lamdaList] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :labelList,:lamdaList] + page := htInitPage("E02BAF - Least-squares curve cubic spline fit",nil) + htSay '"\menuitemstyle{}\tab{2} Values of \space{1} " + htSay '"\htbitmap{xr}: \tab{20} \menuitemstyle{}\tab{22} " + htSay '"Values of \space{1} \htbitmap{fr}: \tab{40}" + htSay '"\menuitemstyle{}\tab{42} Values of \space{1} " + htSay '"\htbitmap{dr}: " + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'e02bafGen) + htpSetProperty(page,'m,m) + htpSetProperty(page,'ncap,ncap) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +e02bafDefaultSolve (htPage,ifail) == + m := '14 + ncap := '5 + page := htInitPage('"E02BAF - Least-squares curve cubic spline fit",nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\menuitemstyle{}\tab{2} Values of \space{1} ") + (text . "\htbitmap{xr}: \tab{20} \menuitemstyle{}\tab{22} ") + (text . "Values of \space{1} \htbitmap{yr}: \tab{40} ") + (text . "\menuitemstyle{}\tab{42} Values of \space{1} ") + (text . "\htbitmap{wr}: ") + (text . "\newline \tab{2}") + (bcStrings (10 "0.20" x1 F)) + (text . "\tab{22} ") + (bcStrings (10 "0.00" y1 F)) + (text . "\tab{42} ") + (bcStrings (10 "0.20" z1 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.47" x2 F)) + (text . "\tab{22} ") + (bcStrings (10 "2.00" y2 F)) + (text . "\tab{42} ") + (bcStrings (10 "0.20" z2 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.74" x3 F)) + (text . "\tab{22} ") + (bcStrings (10 "4.00" y3 F)) + (text . "\tab{42} ") + (bcStrings (10 "0.30" z3 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "1.09" x4 F)) + (text . "\tab{22} ") + (bcStrings (10 "6.00" y4 F)) + (text . "\tab{42} ") + (bcStrings (10 "0.70" z4 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "1.60" x5 F)) + (text . "\tab{22} ") + (bcStrings (10 "8.00" y5 F)) + (text . "\tab{42} ") + (bcStrings (10 "0.90" z5 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "1.90" x6 F)) + (text . "\tab{22} ") + (bcStrings (10 "8.62" y6 F)) + (text . "\tab{42} ") + (bcStrings (10 "1.00" z6 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "2.60" x7 F)) + (text . "\tab{22} ") + (bcStrings (10 "9.10" y7 F)) + (text . "\tab{42} ") + (bcStrings (10 "1.00" z7 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "3.10" x8 F)) + (text . "\tab{22} ") + (bcStrings (10 "8.90" y8 F)) + (text . "\tab{42} ") + (bcStrings (10 "1.00" z8 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "4.00" x9 F)) + (text . "\tab{22} ") + (bcStrings (10 "8.15" y9 F)) + (text . "\tab{42} ") + (bcStrings (10 "0.80" z9 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "5.15" x10 F)) + (text . "\tab{22} ") + (bcStrings (10 "7.00" y10 F)) + (text . "\tab{42} ") + (bcStrings (10 "0.50" z10 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "6.17" x11 F)) + (text . "\tab{22} ") + (bcStrings (10 "6.00" y11 F)) + (text . "\tab{42} ") + (bcStrings (10 "0.70" z11 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "8.00" x12 F)) + (text . "\tab{22} ") + (bcStrings (10 "4.54" y12 F)) + (text . "\tab{42} ") + (bcStrings (10 "1.00" z12 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "10.00" x13 F)) + (text . "\tab{22} ") + (bcStrings (10 "3.39" y13 F)) + (text . "\tab{42} ") + (bcStrings (10 "1.00" z13 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "12.00" x14 F)) + (text . "\tab{22} ") + (bcStrings (10 "2.56" y14 F)) + (text . "\tab{42} ") + (bcStrings (10 "1.00" z14 F)) + (text . "\blankline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "Interior knots \htbitmap{lamdai}, for i = 5,6,...") + (text . "\htbitmap{ncap} + 3: \newline \tab{2}") + (bcStrings (6 "1.50" l1 F)) + (bcStrings (6 "2.60" l2 F)) + (bcStrings (6 "4.00" l3 F)) + (bcStrings (6 "8.00" l4 F)) + (text . "\blankline")) + htMakeDoneButton('"Continue",'e02bafGen) + htpSetProperty(page,'m,m) + htpSetProperty(page,'ncap,ncap) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +e02bafGen htPage == + m := htpProperty(htPage,'m) + ncap := htpProperty(htPage,'ncap) + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + ncap7 := ncap + 7 + y := alist + for i in (ncap+4)..(ncap+7) repeat + lambda := STRCONC( "0.0"," ") + lambdaList := [lambda,:lambdaList] + for i in 5..(ncap+3) repeat + lambda := STRCONC ((first y).1," ") + y := rest y + lambdaList := [lambda,:lambdaList] + for i in 1..4 repeat + lambda := STRCONC( "0.0"," ") + lambdaList := [lambda,:lambdaList] + lambdaString := bcwords2liststring lambdaList + while y repeat + right := STRCONC ((first y).1," ") + y := rest y + mid := STRCONC ((first y).1," ") + y := rest y + left := STRCONC ((first y).1," ") + y := rest y + xlist := [left,:xlist] + ylist := [mid,:ylist] + wlist := [right,:wlist] + xstring := bcwords2liststring xlist + ystring := bcwords2liststring ylist + wstring := bcwords2liststring wlist + prefix := STRCONC('"e02baf(",STRINGIMAGE m,", ",STRINGIMAGE ncap7,", [") + prefix := STRCONC(prefix,xstring,"],[",ystring,"],[",wstring,"], [") + prefix := STRCONC(prefix,lambdaString,"], ",STRINGIMAGE ifail,")") + linkGen prefix + + +e02bbf() == + htInitPage('"E02BBF - Evaluation of fitted cubic spline, function only",nil) + htMakePage '( + (domainConditions + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXe02bbf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02bbf| '|NagFittingPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "Evaluates at the point {\it x} a cubic spline from its B-spline ") + (text . "B-spline representation ") + (text . "\center{\htbitmap{e02baf}} where ") + (text . "\htbitmap{ncap} is the number of intervals of the ") + (text . "spline. The spline has knots \htbitmap{lamdai}, for ") + (text . "i = 1,2,...,\htbitmap{ncap} + 7. \blankline ") + (text . "\newline \menuitemstyle{}\tab{2} \newline ") + (text . "Number of intervals in the spline \htbitmap{ncap}: ") + (text . "\newline\tab{2} ") + (bcStrings (6 4 ncap PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Evaluation point {\it x}:") + (text . "\newline \tab{2} ") + (bcStrings (6 "2.0" x F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Ifail value: ") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'e02bbfSolve) + htShowPage() + +e02bbfSolve htPage == + ncap := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ncap) + objValUnwrap htpLabelSpadValue(htPage, 'ncap) + x := htpLabelInputString(htPage,'x) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + ncap = '4 => e02bbfDefaultSolve(htPage,x,ifail) + labelList := + "append"/[f(i) for i in 1..(ncap+7)] where f(i) == + prefix := ('"\newline \tab{2} ") + middle := ('"\tab{22} ") + lnam := INTERN STRCONC ('"l",STRINGIMAGE i) + cnam := INTERN STRCONC ('"c",STRINGIMAGE i) + num := INTERN STRCONC (STRINGIMAGE (QUOTIENT(i,10)),".",STRINGIMAGE (REM(i,10))) + [['text,:prefix],['bcStrings,[10, num, lnam, 'F]], + ['text,:middle],['bcStrings,[10, 0.0, cnam, 'F]]] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :labelList] + page := htInitPage("E02BBF - Evaluation of fitted cubic spline, function only",nil) + htSay '"\menuitemstyle{}\tab{2} Knots \htbitmap{lamdai}: " + htSay '"\tab{20} \menuitemstyle{}\tab{22} " + htSay '"Coefficients \space{1} \htbitmap{ci}: " + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'e02bbfGen) + htpSetProperty(page,'ncap,ncap) + htpSetProperty(page,'x,x) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +e02bbfDefaultSolve (htPage,x,ifail) == + ncap := '4 + page := htInitPage('"E02BBF - Evaluation of fitted cubic spline, function only",nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Knots \space{1}") + (text . "\htbitmap{lamdai}: \tab{20} \menuitemstyle{}\tab{22} ") + (text . "Coefficients \space{1} \htbitmap{ci}: ") + (text . "\newline \tab{2}") + (bcStrings (10 "1.00" l1 F)) + (text . "\tab{22} ") + (bcStrings (10 "1.00" c1 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "1.00" l2 F)) + (text . "\tab{22} ") + (bcStrings (10 "2.00" c2 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "1.00" l3 F)) + (text . "\tab{22} ") + (bcStrings (10 "4.00" c3 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "1.00" l4 F)) + (text . "\tab{22} ") + (bcStrings (10 "7.00" c4 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "3.00" l5 F)) + (text . "\tab{22} ") + (bcStrings (10 "6.00" c5 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "6.00" l6 F)) + (text . "\tab{22} ") + (bcStrings (10 "4.00" c6 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "8.00" l7 F)) + (text . "\tab{22} ") + (bcStrings (10 "3.00" c7 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "9.00" l8 F)) + (text . "\tab{22} ") + (bcStrings (10 "0.00" c8 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "9.00" l9 F)) + (text . "\tab{22} ") + (bcStrings (10 "0.00" c9 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "9.00" l10 F)) + (text . "\tab{22} ") + (bcStrings (10 "0.00" c10 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "9.00" l11 F)) + (text . "\tab{22} ") + (bcStrings (10 "0.00" c11 F)) + (text . "\blankline")) + htMakeDoneButton('"Continue",'e02bbfGen) + htpSetProperty(page,'ncap,ncap) + htpSetProperty(page,'x,x) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +e02bbfGen htPage == + ncap := htpProperty(htPage,'ncap) + x := htpProperty(htPage,'x) + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + ncap7 := ncap + 7 + y := alist + while y repeat + right := STRCONC ((first y).1," ") + y := rest y + left := STRCONC ((first y).1," ") + y := rest y + lamlist := [left,:lamlist] + clist := [right,:clist] + lamstring := bcwords2liststring lamlist + cstring := bcwords2liststring clist + prefix := STRCONC('"e02bbf(",STRINGIMAGE ncap7,", [",lamstring,"],[") + prefix := STRCONC(prefix,cstring,"], ",x,", ",STRINGIMAGE ifail,")") + linkGen prefix + + +e02bcf() == + htInitPage('"E02BCF - Evaluation of fitted cubic spline, function and derivatives",nil) + htMakePage '( + (domainConditions + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXe02bcf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02bcf| '|NagFittingPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "Evaluates at the point {\it x} a cubic spline and its first ") + (text . "three derivatives from its B-spline representation ") + (text . "\center{\htbitmap{e02baf}} where ") + (text . "\htbitmap{ncap} is the number of intervals of the ") + (text . "spline. The spline has knots \htbitmap{lamdai}, for ") + (text . "i = 1,2,...,\htbitmap{ncap} + 7. \blankline ") + (text . "\newline \menuitemstyle{}\tab{2} \newline ") + (text . "Number of intervals in the spline \htbitmap{ncap}: ") + (text . "\newline\tab{2} ") + (bcStrings (6 7 ncap PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Evaluation point {\it x}:") + (text . "\newline \tab{2} ") + (bcStrings (6 "2.0" x F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "{\it LEFT} specifies whether LH or RH derivatives are required: ") + (radioButtons deriv + ("" " Left-hand derivative" left) + ("" " Right-hand derivative" right)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Ifail value: ") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'e02bcfSolve) + htShowPage() + +e02bcfSolve htPage == + ncap := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ncap) + objValUnwrap htpLabelSpadValue(htPage, 'ncap) + x := htpLabelInputString(htPage,'x) + temp := htpButtonValue(htPage,'deriv) + deriv := + temp = 'left => '1 + '2 + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + ncap = '7 => e02bcfDefaultSolve(htPage,x,deriv,ifail) + labelList := + "append"/[f(i) for i in 1..(ncap+7)] where f(i) == + prefix := ('"\newline \tab{2} ") + middle := ('"\tab{22} ") + lnam := INTERN STRCONC ('"l",STRINGIMAGE i) + cnam := INTERN STRCONC ('"c",STRINGIMAGE i) + num := INTERN STRCONC (STRINGIMAGE (QUOTIENT(i,10)),".",STRINGIMAGE (REM(i,10))) + [['text,:prefix],['bcStrings,[10, num, lnam, 'F]], + ['text,:middle],['bcStrings,[10, 0.0, cnam, 'F]]] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :labelList] + page := htInitPage("E02BCF - Evaluation of fitted cubic spline, function and derivatives",nil) + htSay '"\menuitemstyle{}\tab{2} Knots \htbitmap{lamdai}: " + htSay '"\tab{20} \menuitemstyle{}\tab{22} " + htSay '"Coefficients \space{1} \htbitmap{ci}: " + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'e02bcfGen) + htpSetProperty(page,'ncap,ncap) + htpSetProperty(page,'x,x) + htpSetProperty(page,'deriv,deriv) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +e02bcfDefaultSolve (htPage,x,deriv,ifail) == + ncap := '7 + page := htInitPage('"E02BCF - Evaluation of fitted cubic spline, function and derivatives",nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\menuitemstyle{}\tab{2} Knots \space{1}") + (text . "\htbitmap{lamdai}: \tab{20} \menuitemstyle{}\tab{22} ") + (text . "Coefficients \space{1} \htbitmap{ci}: ") + (text . "\newline \tab{2}") + (bcStrings (10 "0.0" l1 F)) + (text . "\tab{22} ") + (bcStrings (10 "10.00" c1 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.00" l2 F)) + (text . "\tab{22} ") + (bcStrings (10 "12.00" c2 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.00" l3 F)) + (text . "\tab{22} ") + (bcStrings (10 "13.00" c3 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.00" l4 F)) + (text . "\tab{22} ") + (bcStrings (10 "15.00" c4 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "1.00" l5 F)) + (text . "\tab{22} ") + (bcStrings (10 "22.00" c5 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "3.00" l6 F)) + (text . "\tab{22} ") + (bcStrings (10 "26.00" c6 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "3.00" l7 F)) + (text . "\tab{22} ") + (bcStrings (10 "24.00" c7 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "3.00" l8 F)) + (text . "\tab{22} ") + (bcStrings (10 "18.00" c8 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "4.00" l9 F)) + (text . "\tab{22} ") + (bcStrings (10 "14.00" c9 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "4.00" l10 F)) + (text . "\tab{22} ") + (bcStrings (10 "12.00" c10 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "6.00" l11 F)) + (text . "\tab{22} ") + (bcStrings (10 "0.00" c11 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "6.00" l12 F)) + (text . "\tab{22} ") + (bcStrings (10 "0.00" c12 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "6.00" l13 F)) + (text . "\tab{22} ") + (bcStrings (10 "0.00" c13 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "6.00" l14 F)) + (text . "\tab{22} ") + (bcStrings (10 "0.00" c14 F)) + (text . "\blankline")) + htMakeDoneButton('"Continue",'e02bcfGen) + htpSetProperty(page,'ncap,ncap) + htpSetProperty(page,'x,x) + htpSetProperty(page,'deriv,deriv) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +e02bcfGen htPage == + ncap := htpProperty(htPage,'ncap) + x := htpProperty(htPage,'x) + deriv := htpProperty(htPage,'deriv) + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + ncap7 := ncap + 7 + y := alist + while y repeat + right := STRCONC ((first y).1," ") + y := rest y + left := STRCONC ((first y).1," ") + y := rest y + lamlist := [left,:lamlist] + clist := [right,:clist] + lamstring := bcwords2liststring lamlist + cstring := bcwords2liststring clist + prefix := STRCONC('"e02bcf(",STRINGIMAGE ncap7,", [",lamstring,"],[") + prefix := STRCONC(prefix,cstring,"], ",x,", ",STRINGIMAGE deriv) + prefix := STRCONC(prefix,", ",STRINGIMAGE ifail,")") + linkGen prefix + + + +e02bdf() == + htInitPage('"E02BDF - Evaluation of fitted cubic spline, definite integral",nil) + htMakePage '( + (domainConditions + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXe02bdf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02bdf| '|NagFittingPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "Evaluates the definite integral of a cubic spline from its ") + (text . "B-spline representation \center{\htbitmap{e02baf}} ") + (text . "where \htbitmap{ncap} is the number of intervals of ") + (text . "the spline. The spline has knots \htbitmap{lamdai}, ") + (text . "for i = 1,2,...,\htbitmap{ncap} + 7, and the integral ") + (text . "is evaluated over the range \htbitmap{e02bdf} ") + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} \newline ") + (text . "Number of intervals in the spline \htbitmap{ncap}: ") + (text . "\newline\tab{2} ") + (bcStrings (6 7 ncap PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Ifail value: ") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'e02bdfSolve) + htShowPage() + +e02bdfSolve htPage == + ncap := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ncap) + objValUnwrap htpLabelSpadValue(htPage, 'ncap) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + ncap = '7 => e02bdfDefaultSolve(htPage,ifail) + labelList := + "append"/[f(i) for i in 1..(ncap+7)] where f(i) == + prefix := ('"\newline \tab{2} ") + middle := ('"\tab{22} ") + lnam := INTERN STRCONC ('"l",STRINGIMAGE i) + cnam := INTERN STRCONC ('"c",STRINGIMAGE i) + num := INTERN STRCONC (STRINGIMAGE (QUOTIENT(i,10)),".",STRINGIMAGE (REM(i,10))) + [['text,:prefix],['bcStrings,[10, num, lnam, 'F]], + ['text,:middle],['bcStrings,[10, 0.0, cnam, 'F]]] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :labelList] + page := htInitPage("E02BDF - Evaluation of fitted cubic spline, definite integral",nil) + htSay '"\menuitemstyle{}\tab{2} Knots \htbitmap{lamdai}: " + htSay '"\tab{20} \menuitemstyle{}\tab{22} " + htSay '"Coefficients \space{1} \htbitmap{ci}: " + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'e02bdfGen) + htpSetProperty(page,'ncap,ncap) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +e02bdfDefaultSolve(htPage,ifail) == + ncap := '7 + page := htInitPage('"E02BDF - Evaluation of fitted cubic spline, definite integral",nil) + htMakePage '( + (domainConditions + (isDomain EM $EmptyMode) + (isDomain F (Float)) + (isDomain I (Integer))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Knots \space{1}") + (text . "\htbitmap{lamdai}: \tab{20} \menuitemstyle{}\tab{22} ") + (text . "Coefficients \space{1} \htbitmap{ci}: ") + (text . "\newline \tab{2}") + (bcStrings (10 "0.0" l1 F)) + (text . "\tab{22} ") + (bcStrings (10 "10.00" c1 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.00" l2 F)) + (text . "\tab{22} ") + (bcStrings (10 "12.00" c2 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.00" l3 F)) + (text . "\tab{22} ") + (bcStrings (10 "13.00" c3 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.00" l4 F)) + (text . "\tab{22} ") + (bcStrings (10 "15.00" c4 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "1.00" l5 F)) + (text . "\tab{22} ") + (bcStrings (10 "22.00" c5 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "3.00" l6 F)) + (text . "\tab{22} ") + (bcStrings (10 "26.00" c6 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "3.00" l7 F)) + (text . "\tab{22} ") + (bcStrings (10 "24.00" c7 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "3.00" l8 F)) + (text . "\tab{22} ") + (bcStrings (10 "18.00" c8 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "4.00" l9 F)) + (text . "\tab{22} ") + (bcStrings (10 "14.00" c9 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "4.00" l10 F)) + (text . "\tab{22} ") + (bcStrings (10 "12.00" c10 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "6.00" l11 F)) + (text . "\tab{22} ") + (bcStrings (10 "0.00" c11 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "6.00" l12 F)) + (text . "\tab{22} ") + (bcStrings (10 "0.00" c12 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "6.00" l13 F)) + (text . "\tab{22} ") + (bcStrings (10 "0.00" c13 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "6.00" l14 F)) + (text . "\tab{22} ") + (bcStrings (10 "0.00" c14 F))) + htpSetProperty(page,'ncap,ncap) + htpSetProperty(page,'ifail,ifail) + htMakeDoneButton('"Continue",'e02bdfGen) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +e02bdfGen htPage == + ncap := htpProperty(htPage,'ncap) + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + ncap7 := ncap + 7 + y := alist + while y repeat + right := STRCONC ((first y).1," ") + y := rest y + left := STRCONC ((first y).1," ") + y := rest y + lamlist := [left,:lamlist] + clist := [right,:clist] + lamstring := bcwords2liststring lamlist + cstring := bcwords2liststring clist + prefix := STRCONC('"e02bdf(",STRINGIMAGE ncap7,", [",lamstring,"],[") + prefix := STRCONC(prefix,cstring,"], ",STRINGIMAGE ifail,")") + linkGen prefix + + + +e02bef() == + htInitPage('"E02BEF - Least-squares curve cubic spline fit, automatic knot placement",nil) + htMakePage '( + (domainConditions + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXe02bef} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02bef| '|NagFittingPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\newline ") + (text . "Determines a cubic spline approximation to the set of points ") + (text . "{\it ( \htbitmap{xr},\htbitmap{yr}) } ") + (text . "with weights \htbitmap{wr}, for r = 1,2,...,m. ") + (text . "The knots \htbitmap{lamdai}, for i = 1,2,...,n, ") + (text . "are chosen by the routine, but a single parameter S must be ") + (text . "specified to control the trade-off between closeness of fit and ") + (text . "smoothness of fit. This affects the number of knots required ") + (text . "by the spline, which is given in the B-spline representation ") + (text . "\center{\htbitmap{e02bef}}, where n-1 is the number of") + (text . " intervals of the spline. ") + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} \newline ") + (text . "Number of data points {\it m}: ") + (text . "\newline\tab{2} ") + (bcStrings (6 15 m PI)) + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} \newline ") + (text . "Smoothing factor {\it s}: ") + (text . "\newline\tab{2} ") + (bcStrings (6 "1.0" s F)) + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} ") + (text . "Over-estimate of number n of knots {\it nest}:\newline\tab{2} ") + (bcStrings (6 54 nest PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Start value: ") + (radioButtons start + ("" " Cold Start - no values needed for {\it n,lamda,wrk} or {\it iwrk}" cold) + ("" " Warm Start - uses knots found in a previous call" warm)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Ifail value: ") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'e02befSolve) + htShowPage() + +e02befSolve htPage == + m := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) + objValUnwrap htpLabelSpadValue(htPage, 'm) + nest := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nest) + objValUnwrap htpLabelSpadValue(htPage, 'nest) + lwrk := 4*m +16*nest + 41 + s := htpLabelInputString(htPage,'s) + initial := htpButtonValue(htPage,'start) + start := + initial = 'cold => '1 + '2 + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + (m = 15 and start = 1) => e02befDefaultSolve (htPage,nest,lwrk,s,ifail) + start = 1 => e02befColdSolve (htPage,m,nest,lwrk,s,ifail) + -- warm start not really possible from hyperdoc + -- as inputing a workspace array of dimension 1105 is asking too much + -- user should use the command line, using the previous calculated + -- parameters + htInitPage('"E02BEF - Least-squares curve cubic spline fit, automatic knot placement",nil) + htMakePage '( + (domainConditions + (isDomain PI (PositiveInteger))) + (text . "\blankline ") + (text . "{\center{\it Hyperdoc interface not available for warm starts.}}") + (text . "\newline ") + (text . "{\center{\it Please use the command line.}}")) + htMakeDoneButton('"Continue",'e02bef) + htShowPage() + + + +e02befColdSolve(htPage,m,nest,lwrk,s,ifail) == + labelList := + "append"/[f(i) for i in 1..m] where f(i) == + prefix := ('"\newline \tab{2} ") + middle := ('"\tab{22} ") + post := ('" \tab{42} ") + xnam := INTERN STRCONC ('"x",STRINGIMAGE i) + ynam := INTERN STRCONC ('"y",STRINGIMAGE i) + znam := INTERN STRCONC ('"z",STRINGIMAGE i) + num := INTERN STRCONC (STRINGIMAGE (QUOTIENT(i,10)),".",STRINGIMAGE (REM(i,10))) + [['text,:prefix],['bcStrings,[10, num, xnam, 'F]], + ['text,:middle],['bcStrings,[10, 0.0, ynam, 'F]], + ['text,:post],['bcStrings,[10, 0.0, znam, 'F]]] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :labelList] + page := htInitPage('"E02BEF - Least-squares curve cubic spline fit, automatic knot placement",nil) + htSay '"\menuitemstyle{}\tab{2} Values of \space{1} " + htSay '"\htbitmap{xr}: \tab{20} \menuitemstyle{}\tab{22} " + htSay '"Values of \space{1} \htbitmap{yr}: \tab{40}" + htSay '"\menuitemstyle{}\tab{42} Values of \space{1} " + htSay '"\htbitmap{wr}: " + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'e02befColdGen) + htpSetProperty(page,'m,m) + htpSetProperty(page,'nest,nest) + htpSetProperty(page,'lwrk,lwrk) + htpSetProperty(page,'s,s) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +e02befDefaultSolve (htPage,nest,lwrk,s,ifail) == + m := 15 + page := htInitPage('"E02BEF - Least-squares curve cubic spline fit, automatic knot placement",nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Values of \space{1} ") + (text . "\htbitmap{xr}: \tab{20} \menuitemstyle{}\tab{22} ") + (text . "Values of \space{1} \htbitmap{yr}: \tab{40} ") + (text . "\menuitemstyle{}\tab{42} Values of \space{1} ") + (text . "\htbitmap{wr}: ") + (text . "\newline \tab{2}") + (bcStrings (10 "0.00" x1 F)) + (text . "\tab{22} ") + (bcStrings (10 "-1.1" y1 F)) + (text . "\tab{42} ") + (bcStrings (10 "1.00" z1 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "0.50" x2 F)) + (text . "\tab{22} ") + (bcStrings (10 "-0.372" y2 F)) + (text . "\tab{42} ") + (bcStrings (10 "2.00" z2 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "1.00" x3 F)) + (text . "\tab{22} ") + (bcStrings (10 "0.431" y3 F)) + (text . "\tab{42} ") + (bcStrings (10 "1.50" z3 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "1.50" x4 F)) + (text . "\tab{22} ") + (bcStrings (10 "1.69" y4 F)) + (text . "\tab{42} ") + (bcStrings (10 "1.00" z4 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "2.00" x5 F)) + (text . "\tab{22} ") + (bcStrings (10 "2.11" y5 F)) + (text . "\tab{42} ") + (bcStrings (10 "3.00" z5 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "2.50" x6 F)) + (text . "\tab{22} ") + (bcStrings (10 "3.10" y6 F)) + (text . "\tab{42} ") + (bcStrings (10 "1.00" z6 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "3.00" x7 F)) + (text . "\tab{22} ") + (bcStrings (10 "4.23" y7 F)) + (text . "\tab{42} ") + (bcStrings (10 "0.50" z7 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "4.00" x8 F)) + (text . "\tab{22} ") + (bcStrings (10 "4.35" y8 F)) + (text . "\tab{42} ") + (bcStrings (10 "1.00" z8 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "4.50" x9 F)) + (text . "\tab{22} ") + (bcStrings (10 "4.81" y9 F)) + (text . "\tab{42} ") + (bcStrings (10 "2.00" z9 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "5.00" x10 F)) + (text . "\tab{22} ") + (bcStrings (10 "4.61" y10 F)) + (text . "\tab{42} ") + (bcStrings (10 "2.50" z10 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "5.50" x11 F)) + (text . "\tab{22} ") + (bcStrings (10 "4.79" y11 F)) + (text . "\tab{42} ") + (bcStrings (10 "1.00" z11 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "6.00" x12 F)) + (text . "\tab{22} ") + (bcStrings (10 "5.23" y12 F)) + (text . "\tab{42} ") + (bcStrings (10 "3.00" z12 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "7.00" x13 F)) + (text . "\tab{22} ") + (bcStrings (10 "6.35" y13 F)) + (text . "\tab{42} ") + (bcStrings (10 "1.00" z13 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "7.50" x14 F)) + (text . "\tab{22} ") + (bcStrings (10 "7.19" y14 F)) + (text . "\tab{42} ") + (bcStrings (10 "2.00" z14 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "8.00" x15 F)) + (text . "\tab{22} ") + (bcStrings (10 "7.97" y15 F)) + (text . "\tab{42} ") + (bcStrings (10 "1.00" z15 F)) + (text . "\blankline")) + htMakeDoneButton('"Continue",'e02befColdGen) + htpSetProperty(page,'m,m) + htpSetProperty(page,'nest,nest) + htpSetProperty(page,'lwrk,lwrk) + htpSetProperty(page,'s,s) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +e02befColdGen htPage == + m := htpProperty(htPage,'m) + nest := htpProperty(htPage,'nest) + lwrk := htpProperty(htPage,'lwrk) + s := htpProperty(htPage,'s) + cold := '"c" + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + while y repeat + right := STRCONC ((first y).1," ") + y := rest y + mid := STRCONC ((first y).1," ") + y := rest y + left := STRCONC ((first y).1," ") + y := rest y + xlist := [left,:xlist] + ylist := [mid,:ylist] + wlist := [right,:wlist] + xstring := bcwords2liststring xlist + ystring := bcwords2liststring ylist + wstring := bcwords2liststring wlist + -- additional entries needed to get it running + -- but as Start = c they are not used + -- mmax := 50 + -- nest := mmax + 4 (54) + -- lwrk := 4*mmax + 16*nest+41 (1105) + prefix := STRCONC('"e02bef(_"",cold,"_",",STRINGIMAGE m,", [",xstring,"],[") + prefix := STRCONC(prefix,ystring,"],[",wstring,"], ",STRINGIMAGE s,", ") + prefix := STRCONC(prefix,STRINGIMAGE nest,", ",STRINGIMAGE lwrk) +-- prefix := STRCONC(prefix,",0, [[0.0 for i in 1..",STRINGIMAGE nest,"]],") +-- prefix := STRCONC(prefix,STRINGIMAGE ifail,", [[0.0 for i in 1..") +-- prefix := STRCONC(prefix,STRINGIMAGE lwrk,"]], [[0 for i in 1..") +-- prefix := STRCONC(prefix,STRINGIMAGE nest,"]] :: Matrix Integer)") + prefix := STRCONC(prefix,",0, new(1,",STRINGIMAGE nest,",0.0)$Matrix DoubleFloat,") + prefix := STRCONC(prefix,STRINGIMAGE ifail,", new(1,",STRINGIMAGE lwrk,",0.0)$Matrix DoubleFloat, ") + prefix := STRCONC(prefix," new(1,",STRINGIMAGE nest,",0)$Matrix Integer)") + linkGen prefix + +e02def() == + htInitPage('"E02DEF - Evaluation of a fitted bicubic spline at a vector of points",nil) + htMakePage '( + (domainConditions + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXe02def} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02def| '|NagFittingPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "Evaluates a bicubic spline at the (\htbitmap{xr},") + (text . "\htbitmap{yr}), for r = 1,2,...,m, from its B-spline ") + (text . "representation \htbitmap{e02daf} ") + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} \newline ") + (text . "Number of evaluation points, {\it m}: ") + (text . "\newline\tab{2} ") + (bcStrings (6 7 m PI)) + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} \newline ") + (text . "Number of (interior & exterior) knots ") + (text . "\lambda, \htbitmap{px} \htbitmap{great=} 8: \newline\tab{2} ") + (bcStrings (6 11 px PI)) + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} \newline ") + (text . "Number of (interior & exterior) knots ") + (text . "\mu, \htbitmap{py} \htbitmap{great=} 8: \newline\tab{2} ") + (bcStrings (6 10 py PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Ifail value: ") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'e02defSolve) + htShowPage() + +e02defSolve htPage == + m := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) + objValUnwrap htpLabelSpadValue(htPage, 'm) + px := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'px) + objValUnwrap htpLabelSpadValue(htPage, 'px) + py := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'py) + objValUnwrap htpLabelSpadValue(htPage, 'py) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + ((m = '7 and px = '11) and py = '10) => e02defDefaultSolve(htPage,ifail) + labelList := + "append"/[fxy(i) for i in 1..m] where fxy(i) == + prefix := ('"\newline \tab{2} ") + middle := ('"\tab{22} ") + xnam := INTERN STRCONC ('"x",STRINGIMAGE i) + ynam := INTERN STRCONC ('"y",STRINGIMAGE i) + [['text,:prefix],['bcStrings,[8, 0.0, xnam, 'F]], + ['text,:middle],['bcStrings,[8, 0.0, ynam, 'F]]] + lamList := + "append"/[flam(i) for i in 1..px] where flam(i) == + lnam := INTERN STRCONC ('"l",STRINGIMAGE i) + [['bcStrings,[8, 0.0, lnam, 'F]]] + prefix := ('"\blankline \menuitemstyle{} \tab{2} {\it \lambda(nxest)}: \newline") + lamList := [['text,:prefix],:lamList] + muList := + "append"/[fmu(i) for i in 1..(py)] where fmu(i) == + mnam := INTERN STRCONC ('"m",STRINGIMAGE i) + [['bcStrings,[8, 0.0, mnam, 'F]]] + prefix := ('"\blankline \menuitemstyle{} \tab{2} {\it \mu(nyest)}:") + prefix := STRCONC(prefix,"\newline ") + muList := [['text,:prefix],:muList] + cList := + "append"/[fp(i) for i in 1..((px-4)*(py-4))] where fp(i) == + pnam := INTERN STRCONC ('"p",STRINGIMAGE i) + [['bcStrings,[8, 0.0, pnam, 'F]]] + prefix := ('"\blankline \menuitemstyle{}\tab{2}Enter values of ") + prefix := STRCONC(prefix,"{\it c((nxest*4)-(nyest*4))}: \newline ") + cList := [['text,:prefix],:cList] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :labelList,:lamList,:muList,:cList] + page := htInitPage('"E02DEF - Evaluation of a fitted bicubic spline at a vector of points",nil) + htSay '"\menuitemstyle{}\tab{2} Values of \htbitmap{xr}: " + htSay '"\tab{20} \menuitemstyle{}\tab{22} Values of \htbitmap{yr}:" + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'e02defGen) + htpSetProperty(page,'m,m) + htpSetProperty(page,'px,px) + htpSetProperty(page,'py,py) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +e02defDefaultSolve (htPage,ifail) == + m := '7 + px := '11 + py := '10 + page := htInitPage('"E02DEF - Evaluation of a fitted bicubic spline at a vector of points",nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Values of \htbitmap{xr}:") + (text . "\tab{20} \menuitemstyle{} \tab{22} Values of ") + (text . "\htbitmap{yr}: ") + (text . "\newline \tab{2} ") + (bcStrings (8 "1" x1 F)) + (text . "\tab{22}") + (bcStrings (8 "0" y1 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "1.1" x2 F)) + (text . "\tab{22}") + (bcStrings (8 "0.1" y2 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "1.5" x3 F)) + (text . "\tab{22}") + (bcStrings (8 "0.7" y3 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "1.6" x4 F)) + (text . "\tab{22}") + (bcStrings (8 "0.4" y4 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "1.9" x5 F)) + (text . "\tab{22}") + (bcStrings (8 "0.3" y5 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "1.9" x6 F)) + (text . "\tab{22}") + (bcStrings (8 "0.8" y6 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "2" x7 F)) + (text . "\tab{22}") + (bcStrings (8 "1" y7 F)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2} {\it \lambda(nxest)}:") + (text . "\newline ") + (bcStrings (8 "1.0" l1 F)) + (bcStrings (8 "1.0" l2 F)) + (bcStrings (8 "1.0" l3 F)) + (bcStrings (8 "1.0" l4 F)) + (bcStrings (8 "1.3" l5 F)) + (bcStrings (8 "1.5" l6 F)) + (bcStrings (8 "1.6" l7 F)) + (bcStrings (8 "2" l8 F)) + (bcStrings (8 "2" l9 F)) + (bcStrings (8 "2" l10 F)) + (bcStrings (8 "2" l11 F)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2} {\it \mu(nyest)}:") + (text . "\newline ") + (bcStrings (8 "0" mu1 F)) + (bcStrings (8 "0" mu2 F)) + (bcStrings (8 "0" mu3 F)) + (bcStrings (8 "0" mu4 F)) + (bcStrings (8 "0.4" mu5 F)) + (bcStrings (8 "0.7" mu6 F)) + (bcStrings (8 "1" mu7 F)) + (bcStrings (8 "1" mu8 F)) + (bcStrings (8 "1" mu9 F)) + (bcStrings (8 "1" mu10 F)) + (text . "\blankline \menuitemstyle{}\tab{2} ") + (text . "Enter values for {\it c((nxest-4)*(nyest-4))}:") + (text . "\newline ") + (bcStrings (8 "1" c1 F)) + (bcStrings (8 "1.1333" c2 F)) + (bcStrings (8 "1.3667" c3 F)) + (bcStrings (8 "1.7" c4 F)) + (bcStrings (8 "1.9" c5 F)) + (bcStrings (8 "2" c6 F)) + (bcStrings (8 "1.2" c7 F)) + (bcStrings (8 "1.3333" c8 F)) + (bcStrings (8 "1.5667" c9 F)) + (bcStrings (8 "1.9" c10 F)) + (bcStrings (8 "2.1" c11 F)) + (bcStrings (8 "2.2" c12 F)) + (bcStrings (8 "1.5833" c13 F)) + (bcStrings (8 "1.7167" c14 F)) + (bcStrings (8 "1.95" c15 F)) + (bcStrings (8 "2.2833" c16 F)) + (bcStrings (8 "2.4833" c17 F)) + (bcStrings (8 "2.5833" c18 F)) + (bcStrings (8 "2.1433" c19 F)) + (bcStrings (8 "2.2767" c20 F)) + (bcStrings (8 "2.51" c21 F)) + (bcStrings (8 "2.8433" c22 F)) + (bcStrings (8 "3.0433" c23 F)) + (bcStrings (8 "3.1433" c24 F)) + (bcStrings (8 "2.8667" c25 F)) + (bcStrings (8 "3" c26 F)) + (bcStrings (8 "3.2333" c27 F)) + (bcStrings (8 "3.5667" c28 F)) + (bcStrings (8 "3.7667" c29 F)) + (bcStrings (8 "3.8667" c30 F)) + (bcStrings (8 "3.4667" c31 F)) + (bcStrings (8 "3.6" c32 F)) + (bcStrings (8 "3.8333" c33 F)) + (bcStrings (8 "4.1667" c34 F)) + (bcStrings (8 "4.3667" c35 F)) + (bcStrings (8 "4.4667" c36 F)) + (bcStrings (8 "4" c37 F)) + (bcStrings (8 "4.1333" c38 F)) + (bcStrings (8 "4.3667" c39 F)) + (bcStrings (8 "4.7" c40 F)) + (bcStrings (8 "4.9" c41 F)) + (bcStrings (8 "5" c42 F)) + (text . "\blankline ")) + htMakeDoneButton('"Continue",'e02defGen) + htpSetProperty(page,'m,m) + htpSetProperty(page,'px,px) + htpSetProperty(page,'py,py) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +e02defGen htPage == + m := htpProperty(htPage,'m) + px := htpProperty(htPage,'px) + py := htpProperty(htPage,'py) + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + -- c + for i in 1..((px-4)*(py-4)) repeat + right := STRCONC ((first y).1," ") + y := rest y + cList := [right,:cList] + cstring := bcwords2liststring cList + -- mu + for i in 1..py repeat + right := STRCONC ((first y).1," ") + y := rest y + muList := [right,:muList] + mustring := bcwords2liststring muList + -- lamda + for i in 1..px repeat + right := STRCONC ((first y).1," ") + y := rest y + lamList := [right,:lamList] + lamstring := bcwords2liststring lamList + -- x & y + while y repeat + one := STRCONC((first y).1," ") + y := rest y + two := STRCONC((first y).1," ") + y := rest y + xlist := [two,:xlist] + ylist := [one,:ylist] + xstring := bcwords2liststring xlist + ystring := bcwords2liststring ylist + prefix := STRCONC('"e02def(",STRINGIMAGE m,", ",STRINGIMAGE px,", ") + prefix := STRCONC(prefix,STRINGIMAGE py,",[",xstring,"],[",ystring,"],[") + prefix := STRCONC(prefix,lamstring,"],[",mustring,"],[",cstring,"],") + prefix := STRCONC(prefix,STRINGIMAGE ifail,")") + linkGen prefix + + +e02dff() == + htInitPage('"E02DFF - Evaluation of a fitted bicubic spline at a mesh of points",nil) + htMakePage '( + (domainConditions + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXe02dff} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02dff| '|NagFittingPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "Evaluates a bicubic spline at all the points on a rectangular ") + (text . "grid defined by \htbitmap{mx} points ") + (text . "\htbitmap{xq}on the x-axis and \htbitmap{my}") + (text . "points \htbitmap{yr} on the y-axis, from its B-spline ") + (text . "representation \center{\htbitmap{e02daf}} \newline with knot sets ") + (text . "\{\lambda\} and \{\mu\}. ") + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "\newline Grid points on x-axis \htbitmap{mx}: ") + (text . "\tab{32} \menuitemstyle{}\tab{34}") + (text . "Grid points on y-axis \htbitmap{my}: ") + (text . "\newline\tab{2} ") + (bcStrings (6 7 mx PI)) + (text . "\tab{34} ") + (bcStrings (6 6 my PI)) + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} ") + (text . "Number of (interior & exterior) knots \lambda, ") + (text . "\htbitmap{px} \htbitmap{great=} 8: \newline\tab{2} ") + (bcStrings (6 11 px PI)) + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} ") + (text . "Number of (interior & exterior) knots \mu, ") + (text . "\htbitmap{py} \htbitmap{great=} 8: \newline\tab{2} ") + (bcStrings (6 10 py PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Ifail value: ") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'e02dffSolve) + htShowPage() + +e02dffSolve htPage == + mx := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'mx) + objValUnwrap htpLabelSpadValue(htPage, 'mx) + my := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'my) + objValUnwrap htpLabelSpadValue(htPage, 'my) + px := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'px) + objValUnwrap htpLabelSpadValue(htPage, 'px) + py := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'py) + objValUnwrap htpLabelSpadValue(htPage, 'py) + nwrk1 := 4*mx + px + nwrk2 := 4*my + py + nwrklist := [nwrk1,nwrk2] + nwrkmin := APPLY ('MIN, nwrklist) + lwrk := nwrkmin + liwrk := + nwrkmin = nwrk2 => my + py -4 + mx + px -4 + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + ((mx = '7 and my = '6) and (px = '11 and py = '10)) => + e02dffDefaultSolve(htPage,lwrk,liwrk,ifail) + xList := + "append"/[fx(i) for i in 1..mx] where fx(i) == + xnam := INTERN STRCONC ('"x",STRINGIMAGE i) + [['bcStrings,[8, 0.0, xnam, 'F]]] + yList := + "append"/[fy(i) for i in 1..my] where fy(i) == + ynam := INTERN STRCONC ('"y",STRINGIMAGE i) + [['bcStrings,[8, 0.0, ynam, 'F]]] + prefix := ('"\blankline \menuitemstyle{} \tab{2} Enter values of ") + prefix := STRCONC(prefix,"\htbitmap{yr} : \newline") + yList := [['text,:prefix],:yList] + lamList := + "append"/[flam(i) for i in 1..px] where flam(i) == + lnam := INTERN STRCONC ('"l",STRINGIMAGE i) + [['bcStrings,[8, 0.0, lnam, 'F]]] + prefix := ('"\blankline \menuitemstyle{}\tab{2} {\it \lambda(nxest)}:\newline") + lamList := [['text,:prefix],:lamList] + muList := + "append"/[fmu(i) for i in 1..(py)] where fmu(i) == + mnam := INTERN STRCONC ('"m",STRINGIMAGE i) + [['bcStrings,[8, 0.0, mnam, 'F]]] + prefix := ('"\blankline \menuitemstyle{} \tab{2} {\it mu(nyest)}:") + prefix := STRCONC(prefix,"\newline ") + muList := [['text,:prefix],:muList] + cList := + "append"/[fp(i) for i in 1..((px-4)*(py-4))] where fp(i) == + pnam := INTERN STRCONC ('"p",STRINGIMAGE i) + [['bcStrings,[8, 0.0, pnam, 'F]]] + prefix := ('"\blankline \menuitemstyle{}\tab{2} Enter values of ") + prefix := STRCONC(prefix,"{\it c((px-4)*(py-4))}: \newline") + cList := [['text,:prefix],:cList] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :xList,:yList,:lamList,:muList,:cList] + page := htInitPage('"E02DFF - Evaluation of a fitted bicubic spline at a mesh of points",nil) + htSay '"\menuitemstyle{}\tab{2} Values of \htbitmap{xr}:\newline " + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'e02dffGen) + htpSetProperty(page,'mx,mx) + htpSetProperty(page,'my,my) + htpSetProperty(page,'px,px) + htpSetProperty(page,'py,py) + htpSetProperty(page,'lwrk,lwrk) + htpSetProperty(page,'liwrk,liwrk) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +e02dffDefaultSolve (htPage,lwrk,liwrk,ifail) == + mx := '7 + my := '6 + px := '11 + py := '10 + page := htInitPage('"E02DFF - Evaluation of a fitted bicubic spline at a mesh of points",nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Enter values of \htbitmap{xr}:") + (text . "\newline ") + (bcStrings (8 "1" x1 F)) + (bcStrings (8 "1.1" x2 F)) + (bcStrings (8 "1.3" x3 F)) + (bcStrings (8 "1.4" x4 F)) + (bcStrings (8 "1.5" x5 F)) + (bcStrings (8 "1.7" x6 F)) + (bcStrings (8 "2" x7 F)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2} Enter values of \htbitmap{yr}:") + (text . "\newline ") + (bcStrings (8 "0" y1 F)) + (bcStrings (8 "0.2" y2 F)) + (bcStrings (8 "0.4" y3 F)) + (bcStrings (8 "0.6" y4 F)) + (bcStrings (8 "0.8" y5 F)) + (bcStrings (8 "1" y6 F)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2} Enter values of {\it \lambda(nxest)}:") + (text . "\newline ") + (bcStrings (8 "1" l1 F)) + (bcStrings (8 "1" l2 F)) + (bcStrings (8 "1" l3 F)) + (bcStrings (8 "1" l4 F)) + (bcStrings (8 "1.3" l5 F)) + (bcStrings (8 "1.5" l6 F)) + (bcStrings (8 "1.6" l7 F)) + (bcStrings (8 "2" l8 F)) + (bcStrings (8 "2" l9 F)) + (bcStrings (8 "2" l10 F)) + (bcStrings (8 "2" l11 F)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2} Enter values of {\it \mu(nyest)}:") + (text . "\newline ") + (bcStrings (8 "0" mu1 F)) + (bcStrings (8 "0" mu2 F)) + (bcStrings (8 "0" mu3 F)) + (bcStrings (8 "0" mu4 F)) + (bcStrings (8 "0.4" mu5 F)) + (bcStrings (8 "0.7" mu6 F)) + (bcStrings (8 "1" mu7 F)) + (bcStrings (8 "1" mu8 F)) + (bcStrings (8 "1" mu9 F)) + (bcStrings (8 "1" mu10 F)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2} Enter values of {\it c((px-4)*(py-4))}:") + (text . "\newline ") + (bcStrings (8 "1" c1 F)) + (bcStrings (8 "1.1333" c2 F)) + (bcStrings (8 "1.3667" c3 F)) + (bcStrings (8 "1.7" c4 F)) + (bcStrings (8 "1.9" c5 F)) + (bcStrings (8 "2" c6 F)) + (bcStrings (8 "1.2" c7 F)) + (bcStrings (8 "1.3333" c8 F)) + (bcStrings (8 "1.5667" c9 F)) + (bcStrings (8 "1.9" c10 F)) + (bcStrings (8 "2.1" c11 F)) + (bcStrings (8 "2.2" c12 F)) + (bcStrings (8 "1.5833" c13 F)) + (bcStrings (8 "1.7167" c14 F)) + (bcStrings (8 "1.95" c15 F)) + (bcStrings (8 "2.2833" c16 F)) + (bcStrings (8 "2.4833" c17 F)) + (bcStrings (8 "2.5833" c18 F)) + (bcStrings (8 "2.1433" c19 F)) + (bcStrings (8 "2.2767" c20 F)) + (bcStrings (8 "2.51" c21 F)) + (bcStrings (8 "2.8433" c22 F)) + (bcStrings (8 "3.0433" c23 F)) + (bcStrings (8 "3.1433" c24 F)) + (bcStrings (8 "2.8667" c25 F)) + (bcStrings (8 "3" c26 F)) + (bcStrings (8 "3.2333" c27 F)) + (bcStrings (8 "3.5667" c28 F)) + (bcStrings (8 "3.7667" c29 F)) + (bcStrings (8 "3.8667" c30 F)) + (bcStrings (8 "3.4667" c31 F)) + (bcStrings (8 "3.6" c32 F)) + (bcStrings (8 "3.8333" c33 F)) + (bcStrings (8 "4.1667" c34 F)) + (bcStrings (8 "4.3667" c35 F)) + (bcStrings (8 "4.4667" c36 F)) + (bcStrings (8 "4" c37 F)) + (bcStrings (8 "4.1333" c38 F)) + (bcStrings (8 "4.3667" c39 F)) + (bcStrings (8 "4.7" c40 F)) + (bcStrings (8 "4.9" c41 F)) + (bcStrings (8 "5" c42 F)) + (text . "\blankline")) + htMakeDoneButton('"Continue",'e02dffGen) + htpSetProperty(page,'mx,mx) + htpSetProperty(page,'my,my) + htpSetProperty(page,'px,px) + htpSetProperty(page,'py,py) + htpSetProperty(page,'lwrk,lwrk) + htpSetProperty(page,'liwrk,liwrk) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +e02dffGen htPage == + mx := htpProperty(htPage,'mx) + my := htpProperty(htPage,'my) + px := htpProperty(htPage,'px) + py := htpProperty(htPage,'py) + lwrk := htpProperty(htPage,'lwrk) + liwrk := htpProperty(htPage,'liwrk) + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + -- c + for i in 1..((px-4)*(py-4)) repeat + right := STRCONC ((first y).1," ") + y := rest y + cList := [right,:cList] + cstring := bcwords2liststring cList + -- mu + for i in 1..py repeat + right := STRCONC ((first y).1," ") + y := rest y + muList := [right,:muList] + mustring := bcwords2liststring muList + -- lamda + for i in 1..px repeat + right := STRCONC ((first y).1," ") + y := rest y + lamList := [right,:lamList] + lamstring := bcwords2liststring lamList + -- y + for i in 1..my repeat + right := STRCONC ((first y).1," ") + y := rest y + yList := [right,:yList] + ystring := bcwords2liststring yList + -- x + for i in 1..mx repeat + right := STRCONC ((first y).1," ") + y := rest y + xList := [right,:xList] + xstring := bcwords2liststring xList + prefix := STRCONC('"e02dff(",STRINGIMAGE mx,", ",STRINGIMAGE my,", ") + prefix := STRCONC(prefix,STRINGIMAGE px,", ",STRINGIMAGE py,",[") + prefix := STRCONC(prefix,xstring,"],[",ystring,"],[",lamstring,"],[") + prefix := STRCONC(prefix,mustring,"],[",cstring,"],",STRINGIMAGE lwrk,", ") + prefix := STRCONC(prefix,STRINGIMAGE liwrk,", ",STRINGIMAGE ifail,")") + linkGen prefix + +e02gaf() == + htInitPage('"E02GAF - \htbitmap{l1}-approximation by general linear function",nil) + htMakePage '( + (domainConditions + (isDomain F (Float)) + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXe02gaf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02gaf| '|NagFittingPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "Calculates an \htbitmap{l1} solution to the over determined system") + (text . " of linear equations {\it Ax = b}, where A is an {\it m} by {\it n") + (text . "} matrix, {\it x} is an {\it n} element vector, and {\it b} is an ") + (text . "{\it m} element vector. The matrix {\it A} need not be of full ") + (text . "rank. \blankline ") + (text . "\menuitemstyle{}\tab{2} \newline ") + (text . "Number of rows of {\it A}, {\it m}: ") + (text . "\newline\tab{2} ") + (bcStrings (6 5 m PI)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2} \newline ") + (text . "Number of columns of {\it A}, {\it n}: ") + (text . "\newline\tab{2} ") + (bcStrings (6 3 n PI)) +-- (text . "\blankline ") +-- (text . "\menuitemstyle{}\tab{2} \newline ") +-- (text . "First dimension of {\it A(la,n+2)}, {\it la}\htbitmap{great=}") +-- (text . " {\it m + 2}: \newline\tab{2} ") +-- (bcStrings (6 7 la PI)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2} \newline ") + (text . "Tolerance (default is zero), {\it toler}: ") + (text . "\newline\tab{2} ") + (bcStrings (10 "0.0" toler F)) + (text . "\blankline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Ifail value: ") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'e02gafSolve) + htShowPage() + +e02gafSolve htPage == + m := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) + objValUnwrap htpLabelSpadValue(htPage, 'm) + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + la := m+2 +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'la) +-- objValUnwrap htpLabelSpadValue(htPage, 'la) + toler := htpLabelInputString(htPage,'toler) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + ((m = 5 and n = 3) and la = 7) => e02gafDefaultSolve (htPage,toler,ifail) + labelList := + "append"/[fc(i,n) for i in 1..la] where fc(i,n) == + tempList := + "append"/[fr(i,j) for j in 1..(n+2)] where fr(i,j) == + fnam := INTERN STRCONC ('"f",STRINGIMAGE i, STRINGIMAGE j) + [['bcStrings,[9, 0.0, fnam, 'F]]] + prefix := ('"\newline ") + tempList := [['text,:prefix],:tempList] + bList := + "append"/[fb(i) for i in 1..m] where fb(i) == + lnam := INTERN STRCONC ('"l",STRINGIMAGE i) + [['bcStrings,[9, 0.0, lnam, 'F]]] + prefix := ('"\blankline \menuitemstyle{} \tab{2} Values of {\it B(m)}: \newline") + bList := [['text,:prefix],:bList] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :labelList,:bList] + page := htInitPage('"E02GAF - \htbitmap{l1}-approximation by general linear function",nil) + htSay '"\menuitemstyle{}\tab{2} Values of {\it A(la,n+2)}:" + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'e02gafGen) + htpSetProperty(page,'m,m) + htpSetProperty(page,'n,n) + htpSetProperty(page,'la,la) + htpSetProperty(page,'toler,toler) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +e02gafDefaultSolve (htPage,toler,ifail) == + m := '5 + n := '3 + la := '7 + page := htInitPage('"E02GAF - \htbitmap{l1}-approximation by general linear function",nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Values of {\it A(la,n+2)}:") + (text . "\newline ") + (bcStrings (9 "1.0" a11 F)) + (bcStrings (9 "1.0" a12 F)) + (bcStrings (9 "1.0" a13 F)) + (bcStrings (9 "0.0" a14 F)) + (bcStrings (9 "0.0" a15 F)) + (text . "\newline ") + (bcStrings (9 "exp(0.2)" a21 F)) + (bcStrings (9 "exp(-0.2)" a22 F)) + (bcStrings (9 "1.0" a23 F)) + (bcStrings (9 "0.0" a24 F)) + (bcStrings (9 "0.0" a25 F)) + (text . "\newline ") + (bcStrings (9 "exp(0.4)" a31 F)) + (bcStrings (9 "exp(-0.4)" a32 F)) + (bcStrings (9 "1.0" a33 F)) + (bcStrings (9 "0.0" a34 F)) + (bcStrings (9 "0.0" a35 F)) + (text . "\newline ") + (bcStrings (9 "exp(0.6)" a41 F)) + (bcStrings (9 "exp(-0.6)" a42 F)) + (bcStrings (9 "1.0" a43 F)) + (bcStrings (9 "0.0" a44 F)) + (bcStrings (9 "0.0" a45 F)) + (text . "\newline ") + (bcStrings (9 "exp(0.8)" a51 F)) + (bcStrings (9 "exp(-0.8)" a52 F)) + (bcStrings (9 "1.0" a53 F)) + (bcStrings (9 "0.0" a54 F)) + (bcStrings (9 "0.0" a55 F)) + (text . "\newline ") + (bcStrings (9 "0.0" a61 F)) + (bcStrings (9 "0.0" a62 F)) + (bcStrings (9 "0.0" a63 F)) + (bcStrings (9 "0.0" a64 F)) + (bcStrings (9 "0.0" a65 F)) + (text . "\newline ") + (bcStrings (9 "0.0" a71 F)) + (bcStrings (9 "0.0" a72 F)) + (bcStrings (9 "0.0" a73 F)) + (bcStrings (9 "0.0" a74 F)) + (bcStrings (9 "0.0" a75 F)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2} Values of {\it B(m)}:") + (text . "\newline ") + (bcStrings (9 "4.501" b1 F)) + (bcStrings (9 "4.36" b2 F)) + (bcStrings (9 "4.333" b3 F)) + (bcStrings (9 "4.418" b4 F)) + (bcStrings (9 "4.625" b5 F))) + htMakeDoneButton('"Continue",'e02gafGen) + htpSetProperty(page,'m,m) + htpSetProperty(page,'n,n) + htpSetProperty(page,'toler,toler) + htpSetProperty(page,'la,la) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +e02gafGen htPage == + m := htpProperty(htPage,'m) + n := htpProperty(htPage,'n) + la := htpProperty(htPage,'la) + toler := htpProperty(htPage,'toler) + ifail := htpProperty(htPage,'ifail) + nplustwo := n + 2 + alist := htpInputAreaAlist htPage + y := alist + for i in 1..m repeat + right := STRCONC ((first y).1," ") + y := rest y + blist := [right,:blist] + bstring := bcwords2liststring blist + y := REVERSE y + k := -1 + matform := [[y.(k := k + 1).1 for j in 0..(nplustwo-1)] for i in 0..(la-1)] + matstring := bcwords2liststring [bcwords2liststring x for x in matform] + prefix := STRCONC('"e02gaf(",STRINGIMAGE m,", ",STRINGIMAGE la,", ") + prefix := STRCONC(prefix,STRINGIMAGE nplustwo,", ",STRINGIMAGE toler,", ") + prefix := STRCONC(prefix,matstring,",[",bstring,"], ") + prefix := STRCONC(prefix,STRINGIMAGE ifail,")") + linkGen prefix + + +e02daf() == + htInitPage('"E02DAF - Least-squares surface fit, bicubic splines",nil) + htMakePage '( + (domainConditions + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXe02daf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02daf| '|NagFittingPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "Determines a minimal, least squares bicubic B-spline surface fit") + (text . "\htbitmap{e02daf} to the set of points ") + (text . "{\em (\htbitmap{xr},\htbitmap{yr},\htbitmap{fr})} with weights ") + (text . "\htbitmap{wr}, for r = 1,2,...,m. The user must supply internal ") + (text . "knot sets {\lambda},in the x-direction and {\mu} in the ") + (text . "y-direction, ") + (text . "which can be thought of as dividing the data region into panels;") + (text . "s(x,y) consists of a seperate bicubic polynomial in each panel, ") + (text . "the polynomial joining together with second derivative ") + (text . "continuity. Eight additional (external) knots are added to each ") + (text . "of the knot sets by this routine. The routine minimizes \Sigma, ") + (text . "the sum of squares of the weighted residuals ") + (text . "\htbitmap{e02daf1}, for r = 1,2,...,m, subject to the ") + (text . "given knot sets. \newline ") + (text . "A call of this routine should be preceded by a call of E02ZAF ") + (text . "to provide indexing information. ") + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} \newline ") + (text . "Number of data points {\it m}: ") + (text . "\newline\tab{2} ") + (bcStrings (6 30 m PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "\newline Knots in x direction {\em px}") + (text . "\htbitmap{great=} 8: \tab{32} \menuitemstyle{}\tab{34}") + (text . "Knots in y direction {\em py}:") + (text . "\newline\tab{2} ") + (bcStrings (6 8 px PI)) + (text . "\tab{34} ") + (bcStrings (6 10 py PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "\newline Rank threshold {\em eps}:") + (text . "\newline\tab{2} ") + (bcStrings (10 "0.000001" eps F)) + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} \newline ") + (text . "Dimension of point {\it npoint}: ") + (text . "\newline\tab{2} ") + (bcStrings (6 43 npoint PI)) + -- include a radio button later to allow switching of + -- x & y if px <= py + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Ifail value: ") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'e02dafSolve) + htShowPage() + +e02dafSolve htPage == + m := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) + objValUnwrap htpLabelSpadValue(htPage, 'm) + px := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'px) + objValUnwrap htpLabelSpadValue(htPage, 'px) + py := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'py) + objValUnwrap htpLabelSpadValue(htPage, 'py) + npoint := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'npoint) + objValUnwrap htpLabelSpadValue(htPage, 'npoint) + nc := (px - 4)*(py - 4) + nws := (2*nc + 1)*(3*py - 6) -2 + eps := htpLabelInputString(htPage,'eps) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + ((m = '30 and px = '8) and py = '10) => e02dafDefaultSolve(htPage,eps,nws,npoint,ifail) + labelList := + "append"/[fxy(i) for i in 1..m] where fxy(i) == + prefix := ('"\newline \tab{2} ") + middle := ('"\tab{17} ") + next := ('"\tab{32} ") + end := ('"\tab{47} ") + xnam := INTERN STRCONC ('"x",STRINGIMAGE i) + ynam := INTERN STRCONC ('"y",STRINGIMAGE i) + fnam := INTERN STRCONC ('"f",STRINGIMAGE i) + wnam := INTERN STRCONC ('"w",STRINGIMAGE i) + [['text,:prefix],['bcStrings,[8, 0.0, xnam, 'F]], + ['text,:middle],['bcStrings,[8, 0.0, ynam, 'F]], + ['text,:next],['bcStrings,[8, 0.0, fnam, 'F]], + ['text,:end],['bcStrings,[8, 0.0, wnam, 'F]]] + lamList := + "append"/[flam(i) for i in 5..(px-4)] where flam(i) == + lnam := INTERN STRCONC ('"l",STRINGIMAGE i) + [['bcStrings,[8, 0.0, lnam, 'F]]] + prefix := ('"\blankline \menuitemstyle{} \tab{2} lamda(5) to lamda(px-4): ") + prefix := STRCONC(prefix,"\newline \tab{2} ") + postfix := ('"\newline \blankline ") + lamList := [['text,:prefix],:lamList,['text,:postfix]] + muList := + "append"/[fmu(i) for i in 5..(py-4)] where fmu(i) == + mnam := INTERN STRCONC ('"m",STRINGIMAGE i) + [['bcStrings,[8, 0.0, mnam, 'F]]] + prefix := ('"\menuitemstyle{} \tab{2} mu(5) to mu(py-4):") + prefix := STRCONC(prefix,"\newline \tab{2} ") + muList := [['text,:prefix],:muList] + pList := + "append"/[fp(i) for i in 1..npoint] where fp(i) == + prefix := ('"\newline \tab{2} ") + pnam := INTERN STRCONC ('"p",STRINGIMAGE i) + [['text,:prefix],['bcStrings,[8, 0.0, pnam, 'F]]] + prefix := ('"\blankline \menuitemstyle{} \tab{2} Enter values of Point: ") + pList := [['text,:prefix],:pList] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :labelList,:lamList,:muList,:pList] + page := htInitPage('"E02DAF - Least-squares surface fit, bicubic splines",nil) + htSay '"\menuitemstyle{}\tab{2} Values of \htbitmap{xr}: " + htSay '"\tab{15} \menuitemstyle{}\tab{17} Values of \htbitmap{yr}:" + htSay '"\tab{30} \menuitemstyle{}\tab{32} Values of \htbitmap{fr}:" + htSay '"\tab{44} \menuitemstyle{}\tab{46} Values of \htbitmap{wr}:" + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'e02dafGen) + htpSetProperty(page,'m,m) + htpSetProperty(page,'px,px) + htpSetProperty(page,'py,py) + htpSetProperty(page,'nws,nws) + htpSetProperty(page,'eps,eps) + htpSetProperty(page,'npoint,npoint) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +e02dafDefaultSolve (htPage,eps,nws,npoint,ifail) == + m := '30 + px := '8 + py := '10 + page := htInitPage('"E02DAF - Least-squares surface fit, bicubic splines",nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Values of \htbitmap{xr}:") + (text . "\tab{15} \menuitemstyle{} \tab{17} Values of ") + (text . "\htbitmap{yr}: \tab{30} \menuitemstyle{} \tab{32} ") + (text . "Values of \htbitmap{fr}: \tab{44} \menuitemstyle{} ") + (text . "\tab{46} Values of \htbitmap{wr}:") + (text . "\newline \tab{2} ") + (bcStrings (8 "-0.52" x1 F)) + (text . "\tab{17}") + (bcStrings (8 "0.60" y1 F)) + (text . "\tab{32}") + (bcStrings (8 "0.93" f1 F)) + (text . "\tab{47}") + (bcStrings (8 "10" w1 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "-0.61" x2 F)) + (text . "\tab{17}") + (bcStrings (8 "-0.95" y2 F)) + (text . "\tab{32}") + (bcStrings (8 "-1.79" f2 F)) + (text . "\tab{47}") + (bcStrings (8 "10" w2 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "0.93" x3 F)) + (text . "\tab{17}") + (bcStrings (8 "0.87" y3 F)) + (text . "\tab{32}") + (bcStrings (8 "0.36" f3 F)) + (text . "\tab{47}") + (bcStrings (8 "10" w3 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "0.09" x4 F)) + (text . "\tab{17}") + (bcStrings (8 "0.84" y4 F)) + (text . "\tab{32}") + (bcStrings (8 "0.52" f4 F)) + (text . "\tab{47}") + (bcStrings (8 "10" w4 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "0.88" x5 F)) + (text . "\tab{17}") + (bcStrings (8 "0.17" y5 F)) + (text . "\tab{32}") + (bcStrings (8 "0.49" f5 F)) + (text . "\tab{47}") + (bcStrings (8 "10" w5 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "-0.70" x6 F)) + (text . "\tab{17}") + (bcStrings (8 "-0.87" y6 F)) + (text . "\tab{32}") + (bcStrings (8 "-1.76" f6 F)) + (text . "\tab{47}") + (bcStrings (8 "10" w6 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "1" x7 F)) + (text . "\tab{17}") + (bcStrings (8 "1" y7 F)) + (text . "\tab{32}") + (bcStrings (8 "0.33" f7 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w7 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "1" x8 F)) + (text . "\tab{17}") + (bcStrings (8 "0.1" y8 F)) + (text . "\tab{32}") + (bcStrings (8 "0.48" f8 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w8 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "0.3" x9 F)) + (text . "\tab{17}") + (bcStrings (8 "0.24" y9 F)) + (text . "\tab{32}") + (bcStrings (8 "0.65" f9 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w9 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "-0.77" x10 F)) + (text . "\tab{17}") + (bcStrings (8 "-0.77" y10 F)) + (text . "\tab{32}") + (bcStrings (8 "-1.82" f10 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w10 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "-0.23" x11 F)) + (text . "\tab{17}") + (bcStrings (8 "0.32" y11 F)) + (text . "\tab{32}") + (bcStrings (8 "0.92" f11 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w11 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "-1" x12 F)) + (text . "\tab{17}") + (bcStrings (8 "1" y12 F)) + (text . "\tab{32}") + (bcStrings (8 "1" f12 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w12 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "-0.26" x13 F)) + (text . "\tab{17}") + (bcStrings (8 "-0.63" y13 F)) + (text . "\tab{32}") + (bcStrings (8 "8.88" f13 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w13 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "-0.83" x14 F)) + (text . "\tab{17}") + (bcStrings (8 "-0.66" y14 F)) + (text . "\tab{32}") + (bcStrings (8 "-2.01" f14 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w14 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "0.22" x15 F)) + (text . "\tab{17}") + (bcStrings (8 "0.93" y15 F)) + (text . "\tab{32}") + (bcStrings (8 "0.47" f15 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w15 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "0.89" x16 F)) + (text . "\tab{17}") + (bcStrings (8 "0.15" y16 F)) + (text . "\tab{32}") + (bcStrings (8 "0.49" f16 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w16 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "-0.80" x17 F)) + (text . "\tab{17}") + (bcStrings (8 "0.99" y17 F)) + (text . "\tab{32}") + (bcStrings (8 "0.84" f17 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w17 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "-0.88" x18 F)) + (text . "\tab{17}") + (bcStrings (8 "-0.54" y18 F)) + (text . "\tab{32}") + (bcStrings (8 "-2.42" f18 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w18 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "0.68" x19 F)) + (text . "\tab{17}") + (bcStrings (8 "0.44" y19 F)) + (text . "\tab{32}") + (bcStrings (8 "0.47" f19 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w19 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "-0.14" x20 F)) + (text . "\tab{17}") + (bcStrings (8 "-0.72" y20 F)) + (text . "\tab{32}") + (bcStrings (8 "7.15" f20 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w20 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "0.67" x21 F)) + (text . "\tab{17}") + (bcStrings (8 "0.63" y21 F)) + (text . "\tab{32}") + (bcStrings (8 "0.44" f21 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w21 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "-0.90" x22 F)) + (text . "\tab{17}") + (bcStrings (8 "-0.40" y22 F)) + (text . "\tab{32}") + (bcStrings (8 "-3.34" f22 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w22 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "-0.84" x23 F)) + (text . "\tab{17}") + (bcStrings (8 "0.20" y23 F)) + (text . "\tab{32}") + (bcStrings (8 "2.78" f23 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w23 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "0.84" x24 F)) + (text . "\tab{17}") + (bcStrings (8 "0.43" y24 F)) + (text . "\tab{32}") + (bcStrings (8 "0.44" f24 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w24 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "0.15" x25 F)) + (text . "\tab{17}") + (bcStrings (8 "0.28" y25 F)) + (text . "\tab{32}") + (bcStrings (8 "0.70" f25 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w25 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "-0.91" x26 F)) + (text . "\tab{17}") + (bcStrings (8 "-0.24" y26 F)) + (text . "\tab{32}") + (bcStrings (8 "-6.52" f26 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w26 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "-0.35" x27 F)) + (text . "\tab{17}") + (bcStrings (8 "0.86" y27 F)) + (text . "\tab{32}") + (bcStrings (8 "0.66" f27 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w27 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "-0.16" x28 F)) + (text . "\tab{17}") + (bcStrings (8 "-0.41" y28 F)) + (text . "\tab{32}") + (bcStrings (8 "2.32" f28 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w28 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "-0.35" x29 F)) + (text . "\tab{17}") + (bcStrings (8 "-0.05" y29 F)) + (text . "\tab{32}") + (bcStrings (8 "1.66" f29 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w29 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "-1" x30 F)) + (text . "\tab{17}") + (bcStrings (8 "-1" y30 F)) + (text . "\tab{32}") + (bcStrings (8 "-1" f30 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w30 F)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2} mu(5) to mu(py-4):") + (text . "\newline \tab{2}") + (bcStrings (8 "-0.50" mu5 F)) + (bcStrings (8 "0.00" mu6 F)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2} Enter values for point:") + (text . "\newline \tab{2}") + (bcStrings (6 3 p1 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 6 p2 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 4 p3 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 5 p4 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 7 p5 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 10 p6 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 8 p7 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 9 p8 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 11 p9 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 13 p10 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 12 p11 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 15 p12 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 14 p13 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 18 p14 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 16 p15 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 17 p16 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 19 p17 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 20 p18 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 21 p19 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 30 p20 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 23 p21 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 26 p22 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 24 p23 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 25 p24 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 27 p25 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 28 p26 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 0 p27 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 29 p28 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 0 p29 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 0 p30 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 2 p31 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 22 p32 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 1 p33 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 0 p34 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 0 p35 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 0 p36 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 0 p37 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 0 p38 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 0 p39 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 0 p40 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 0 p41 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 0 p42 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 0 p43 PI)) + (text . "\blankline")) + htMakeDoneButton('"Continue",'e02dafGen) + htpSetProperty(page,'m,m) + htpSetProperty(page,'px,px) + htpSetProperty(page,'py,py) + htpSetProperty(page,'nws,nws) + htpSetProperty(page,'eps,eps) + htpSetProperty(page,'npoint,npoint) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +e02dafGen htPage == + m := htpProperty(htPage,'m) + px := htpProperty(htPage,'px) + py := htpProperty(htPage,'py) + nws := htpProperty(htPage,'nws) + eps := htpProperty(htPage,'eps) + npoint := htpProperty(htPage,'npoint) + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + nadres := (px-7)*(py-7) + -- point + for i in 1..npoint repeat + right := STRCONC ((first y).1," ") + y := rest y + pointList := [right,:pointList] + pstring := bcwords2liststring pointList + -- mu + for i in 1..4 repeat + muList := ['"0 ",:muList] + for i in 5..(py-4) repeat + right := STRCONC ((first y).1," ") + y := rest y + muList := [right,:muList] + for i in (py-3)..py repeat + muList := ['"0 ",:muList] + mustring := bcwords2liststring muList + -- lamda + for i in 1..4 repeat + lamList := ['"0 ",:lamList] + for i in 5..(px-4) repeat + right := STRCONC ((first y).1," ") + y := rest y + lamList := [right,:lamList] + for i in (px-3)..px repeat + lamList := ['"0 ",:lamList] + lamstring := bcwords2liststring lamList + -- x & y + while y repeat + one := STRCONC((first y).1," ") + y := rest y + two := STRCONC((first y).1," ") + y := rest y + three := STRCONC ((first y).1," ") + y := rest y + four := STRCONC ((first y).1," ") + y := rest y + xlist := [four,:xlist] + ylist := [three,:ylist] + flist := [two,:flist] + wlist := [one,:wlist] + xstring := bcwords2liststring xlist + ystring := bcwords2liststring ylist + fstring := bcwords2liststring flist + wstring := bcwords2liststring wlist + nc := (px-4)*(py-4) + prefix := STRCONC('"e02daf(",STRINGIMAGE m,", ",STRINGIMAGE px,", ") + prefix := STRCONC(prefix,STRINGIMAGE py,",[",xstring,"],[",ystring,"],[") + prefix := STRCONC(prefix,fstring,"],[",wstring,"],[",mustring,"],[") + prefix := STRCONC(prefix,pstring,"], ",STRINGIMAGE npoint,", ") + prefix := STRCONC(prefix,STRINGIMAGE nc,", ",STRINGIMAGE nws,", ",eps,", [") + prefix := STRCONC(prefix,lamstring,"], ",STRINGIMAGE ifail,")") + linkGen prefix + + +e02dcf() == + htInitPage('"E02DCF - Least-squares curve by bicubic splines with automatic knot placement, data on a rectangular grid",nil) + htMakePage '( + (domainConditions + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXe02dcf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02dcf| '|NagFittingPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\newline ") + (text . "Determines a bicubic spline approximation to a set of points ") + (text . "given on a rectangular grid defined by \htbitmap{mx} ") + (text . "points \htbitmap{xq} on the x-axis and ") + (text . "\htbitmap{my} points \htbitmap{yr} on the ") + (text . "y-axix. The knots \htbitmap{lamdai}, for i = 1,2,...,") + (text . "\htbitmap{nx} and \htbitmap{mui}, for ") + (text . "i = 1,2,...,\htbitmap{ny} are chosen for this routine ") + (text . ", but a single parameter S must be specified to control the ") + (text . "trade-off between closeness of fit and smoothness of fit. This ") + (text . "affects the number of knots required by the spline, which is ") + (text . "given in the B-spline representation \htbitmap{e02daf}") + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} \newline ") + (text . "Grid points on x-axis \htbitmap{mx}: ") + (text . "\tab{30} \menuitemstyle{}\tab{32} Grid points on y-axis ") + (text . "\htbitmap{my}: ") + (text . "\newline\tab{2} ") + (bcStrings (6 11 mx PI)) + (text . "\tab{32} ") + (bcStrings (6 9 my PI)) + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} ") + (text . "Over-estimate of \htbitmap{nx} of knots \lambda of the ") + (text . "computed spline, {\it nxest}: \newline\tab{2} ") + (bcStrings (6 15 nxest PI)) + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} ") + (text . "Over-estimate of \htbitmap{ny} of knots \mu of the computed ") + (text . "spline, {\it nyest}: \newline\tab{2} ") + (bcStrings (6 13 nyest PI)) + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} \newline ") + (text . "Smoothing factor {\it s}: ") + (text . "\newline\tab{2} ") + (bcStrings (6 "0.1" s F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Start value: ") + (radioButtons start + ("" " Cold Start - no values needed for {\it nx,ny,lamda,mu} or {\it iwrk}" cold) + ("" " Warm Start - uses knots found in a previous call" warm)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Ifail value: ") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'e02dcfSolve) + htShowPage() + +e02dcfSolve htPage == + mx := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'mx) + objValUnwrap htpLabelSpadValue(htPage, 'mx) + my := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'my) + objValUnwrap htpLabelSpadValue(htPage, 'my) + nxest := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nxest) + objValUnwrap htpLabelSpadValue(htPage, 'nxest) + nyest := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nyest) + objValUnwrap htpLabelSpadValue(htPage, 'nyest) + wrklist := [my,nxest] + wrkmax := APPLY ('MAX, wrklist) + lwrk := 4*(mx + my) +11*(nxest + nyest) + nxest*my + wrkmax +54 + liwrk := 3 + mx + my + nxest + nyest + s := htpLabelInputString(htPage,'s) + initial := htpButtonValue(htPage,'start) + start := + initial = 'cold => '1 + '2 + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + ((mx = 11 and my = 9) and start = 1) => + e02dcfDefaultSolve (htPage,nxest,nyest,lwrk,liwrk,s,ifail) + start = 1 => e02dcfColdSolve (htPage,mx,my,nxest,nyest,lwrk,liwrk,s,ifail) + -- warm start not really possible from hyperdoc + -- as inputing a workspace array of dimension 592 is asking too much + -- user should use the command line, using the previous calculated + -- parameters + htInitPage('"E02DCF - Least-squares curve by bicubic splines with automatic knot placement, data on a rectangular grid",nil) + htMakePage '( + (domainConditions + (isDomain PI (PositiveInteger))) + (text . "\blankline ") + (text . "{\center{\em Hyperdoc interface not available for warm starts.}}") + (text . "\newline ") + (text . "{\center{\em Please use the command line.}}")) + htMakeDoneButton('"Continue",'e02dcf) + htShowPage() + + + +e02dcfColdSolve(htPage,mx,my,nxest,nyest,lwrk,liwrk,s,ifail) == + xList := + "append"/[f(i) for i in 1..mx] where f(i) == + xnam := INTERN STRCONC ('"x",STRINGIMAGE i) + [['bcStrings,[8, 0.0, xnam, 'F]]] + yList := + "append"/[g(i) for i in 1..my] where g(i) == + ynam := INTERN STRCONC ('"g",STRINGIMAGE i) + [['bcStrings,[8, 0.0, ynam, 'F]]] + prefix:= ('"\blankline \menuitemstyle{}\tab{2} Values of {\it y(my)}: \newline ") + yList := [['text,:prefix],:yList] + fList := + "append"/[h(i) for i in 1..(mx*my)] where h(i) == + fnam := INTERN STRCONC ('"g",STRINGIMAGE i) + [['bcStrings,[8, 0.0, fnam, 'F]]] + prefix:=('"\blankline \menuitemstyle{} \tab{2} Values of {\it f(mx*my)}: \newline ") + fList := [['text,:prefix],:fList] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :xList,:yList,:fList] + page := htInitPage('"E02DCF - Least-squares curve by bicubic splines with automatic knot placement, data on a rectangular grid",nil) + htSay '"\menuitemstyle{}\tab{2} Values of {\it x(mx)}: \newline " + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'e02dcfColdGen) + htpSetProperty(page,'mx,mx) + htpSetProperty(page,'my,my) + htpSetProperty(page,'nxest,nxest) + htpSetProperty(page,'nyest,nyest) + htpSetProperty(page,'lwrk,lwrk) + htpSetProperty(page,'liwrk,liwrk) + htpSetProperty(page,'s,s) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +e02dcfDefaultSolve (htPage,nxest,nyest,lwrk,liwrk,s,ifail) == + mx := 11 + my := 9 + page := htInitPage('"E02DCF - Least-squares curve by bicubic splines with automatic knot placement, data on a rectangular grid",nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Values of {\it x(mx)}:") + (text . "\newline ") + (bcStrings (8 "0" x1 F)) + (bcStrings (8 "0.5" x2 F)) + (bcStrings (8 "1" x3 F)) + (bcStrings (8 "1.5" x4 F)) + (bcStrings (8 "2" x5 F)) + (bcStrings (8 "2.5" x6 F)) + (bcStrings (8 "3" x7 F)) + (bcStrings (8 "3.5" x8 F)) + (bcStrings (8 "4" x9 F)) + (bcStrings (8 "4.5" x10 F)) + (bcStrings (8 "5" x11 F)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2} Values of {\it y(my)}:") + (text . "\newline ") + (bcStrings (8 "0" y1 F)) + (bcStrings (8 "0.5" y2 F)) + (bcStrings (8 "1" y3 F)) + (bcStrings (8 "1.5" y4 F)) + (bcStrings (8 "2" y5 F)) + (bcStrings (8 "2.5" y6 F)) + (bcStrings (8 "3" y7 F)) + (bcStrings (8 "3.5" y8 F)) + (bcStrings (8 "4" y9 F)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2} Values of {\it f(mx*my)}:") + (text . "\newline ") + (bcStrings (8 "1" f1 F)) + (bcStrings (8 "0.88758" f2 F)) + (bcStrings (8 "0.5403" f3 F)) + (bcStrings (8 "0.070737" f4 F)) + (bcStrings (8 "-0.41515" f5 F)) + (bcStrings (8 "-0.80114" f6 F)) + (bcStrings (8 "-0.97999" f7 F)) + (bcStrings (8 "-0.93446" f8 F)) + (bcStrings (8 "-0.65664" f9 F)) + (bcStrings (8 "1.5" f10 F)) + (bcStrings (8 "1.3564" f11 F)) + (bcStrings (8 "0.82045" f12 F)) + (bcStrings (8 "0.10611" f13 F)) + (bcStrings (8 "-0.62422" f14 F)) + (bcStrings (8 "-1.2317" f15 F)) + (bcStrings (8 "-1.485" f16 F)) + (bcStrings (8 "-1.3047" f17 F)) + (bcStrings (8 "-0.98547" f18 F)) + (bcStrings (8 "2.06" f19 F)) + (bcStrings (8 "1.7552" f20 F)) + (bcStrings (8 "1.0806" f21 F)) + (bcStrings (8 "0.15147" f22 F)) + (bcStrings (8 "-0.83229" f23 F)) + (bcStrings (8 "-1.6023" f24 F)) + (bcStrings (8 "-1.97" f25 F)) + (bcStrings (8 "-1.8729" f26 F)) + (bcStrings (8 "-1.4073" f27 F)) + (bcStrings (8 "2.57" f28 F)) + (bcStrings (8 "2.124" f29 F)) + (bcStrings (8 "1.3508" f30 F)) + (bcStrings (8 "0.17684" f31 F)) + (bcStrings (8 "-1.0404" f32 F)) + (bcStrings (8 "-2.0029" f33 F)) + (bcStrings (8 "-2.475" f34 F)) + (bcStrings (8 "-2.3511" f35 F)) + (bcStrings (8 "-1.6741" f36 F)) + (bcStrings (8 "3" f37 F)) + (bcStrings (8 "2.6427" f38 F)) + (bcStrings (8 "1.6309" f39 F)) + (bcStrings (8 "0.21221" f40 F)) + (bcStrings (8 "-1.2484" f41 F)) + (bcStrings (8 "-2.2034" f42 F)) + (bcStrings (8 "-2.97" f43 F)) + (bcStrings (8 "-2.8094" f44 F)) + (bcStrings (8 "-1.9809" f45 F)) + (bcStrings (8 "3.5" f46 F)) + (bcStrings (8 "3.1715" f47 F)) + (bcStrings (8 "1.8611" f48 F)) + (bcStrings (8 "0.24458" f49 F)) + (bcStrings (8 "-1.4565" f50 F)) + (bcStrings (8 "-2.864" f51 F)) + (bcStrings (8 "-3.265" f52 F)) + (bcStrings (8 "-3.2776" f53 F)) + (bcStrings (8 "-2.2878" f54 F)) + (bcStrings (8 "4.04" f55 F)) + (bcStrings (8 "3.5103" f56 F)) + (bcStrings (8 "2.0612" f57 F)) + (bcStrings (8 "0.28595" f58 F)) + (bcStrings (8 "-1.6946" f59 F)) + (bcStrings (8 "-3.2046" f60 F)) + (bcStrings (8 "-3.96" f61 F)) + (bcStrings (8 "-3.7958" f62 F)) + (bcStrings (8 "-2.6146" f63 F)) + (bcStrings (8 "4.5" f64 F)) + (bcStrings (8 "3.9391" f65 F)) + (bcStrings (8 "2.4314" f66 F)) + (bcStrings (8 "0.31632" f67 F)) + (bcStrings (8 "-1.8627" f68 F)) + (bcStrings (8 "-3.6351" f69 F)) + (bcStrings (8 "-4.455" f70 F)) + (bcStrings (8 "-4.2141" f71 F)) + (bcStrings (8 "-2.9314" f72 F)) + (bcStrings (8 "5.04" f73 F)) + (bcStrings (8 "4.3879" f74 F)) + (bcStrings (8 "2.7515" f75 F)) + (bcStrings (8 "0.35369" f76 F)) + (bcStrings (8 "-2.0707" f77 F)) + (bcStrings (8 "-4.0057" f78 F)) + (bcStrings (8 "-4.97" f79 F)) + (bcStrings (8 "-4.6823" f80 F)) + (bcStrings (8 "-3.2382" f81 F)) + (bcStrings (8 "5.505" f82 F)) + (bcStrings (8 "4.8367" f83 F)) + (bcStrings (8 "2.9717" f84 F)) + (bcStrings (8 "0.38505" f85 F)) + (bcStrings (8 "-2.2888" f86 F)) + (bcStrings (8 "-4.4033" f87 F)) + (bcStrings (8 "-5.445" f88 F)) + (bcStrings (8 "-5.1405" f89 F)) + (bcStrings (8 "-3.595" f90 F)) + (bcStrings (8 "6" f91 F)) + (bcStrings (8 "5.2755" f92 F)) + (bcStrings (8 "3.2418" f93 F)) + (bcStrings (8 "0.42442" f94 F)) + (bcStrings (8 "-2.4769" f95 F)) + (bcStrings (8 "-4.8169" f96 F)) + (bcStrings (8 "-5.93" f97 F)) + (bcStrings (8 "-5.6387" f98 F)) + (bcStrings (8 "-3.9319" f99 F))) + htMakeDoneButton('"Continue",'e02dcfColdGen) + htpSetProperty(page,'mx,mx) + htpSetProperty(page,'my,my) + htpSetProperty(page,'nxest,nxest) + htpSetProperty(page,'nyest,nyest) + htpSetProperty(page,'lwrk,lwrk) + htpSetProperty(page,'liwrk,liwrk) + htpSetProperty(page,'s,s) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +e02dcfColdGen htPage == + mx := htpProperty(htPage,'mx) + my := htpProperty(htPage,'my) + nxest := htpProperty(htPage,'nxest) + nyest := htpProperty(htPage,'nyest) + lwrk := htpProperty(htPage,'lwrk) + liwrk := htpProperty(htPage,'liwrk) + s := htpProperty(htPage,'s) + cold := '"c" + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + for i in 1..(mx*my) repeat + end := STRCONC((first y).1," ") + y := rest y + fList := [end,:fList] + fstring := bcwords2liststring fList + for i in 1..my repeat + mid := STRCONC ((first y).1," ") + y := rest y + ylist := [mid,:ylist] + ystring := bcwords2liststring ylist + while y repeat + start := STRCONC ((first y).1," ") + y := rest y + xlist := [start,:xlist] + xstring := bcwords2liststring xlist + -- additional entries needed to get it running + -- but as Start = c they are not used + prefix := STRCONC('"e02dcf(_"",cold,"_",",STRINGIMAGE mx,", [",xstring,"],") + prefix := STRCONC(prefix,STRINGIMAGE my,",[",ystring,"],[",fstring,"], ") + prefix := STRCONC(prefix,STRINGIMAGE s,", ",STRINGIMAGE nxest,", ") + prefix := STRCONC(prefix,STRINGIMAGE nyest,", ",STRINGIMAGE lwrk,", ") + prefix := STRCONC(prefix,STRINGIMAGE liwrk,",0,new(1,", STRINGIMAGE nxest,",0.0)$MATRIX DFLOAT,") + prefix := STRCONC(prefix,"0,new(1,", STRINGIMAGE nyest,",0.0)$MATRIX DFLOAT,") + end := STRCONC("new(1,", STRINGIMAGE lwrk,",0.0)$MATRIX DFLOAT,[[0 for i in 1..") + end := STRCONC(end,STRINGIMAGE liwrk,"]]::Matrix Integer,",STRINGIMAGE ifail,")") + linkGen STRCONC(prefix,end) + + +e02ddf() == + htInitPage('"E02DDF - Least-squares surface fit by bicubic splines with automatic knot placement, scattered data",nil) + htMakePage '( + (domainConditions + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXe02ddf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02ddf| '|NagFittingPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\newline ") + (text . "Determines a bicubic spline approximation to a set of scattered") + (text . " points ( \htbitmap{xr},\htbitmap{yr}, ") + (text . "\htbitmap{fr})") + (text . "with weights \htbitmap{wr}, for r = 1,2,...,m. ") + (text . "The knots \htbitmap{lamdai}, for i = 1,2,...,") + (text . "\htbitmap{nx} and \htbitmap{mui}, for ") + (text . "i = 1,2,...,\htbitmap{ny} are chosen by the routine ") + (text . ", but a single parameter S must be specified to control the ") + (text . "trade-off between closeness of fit and smoothness of fit. This ") + (text . "affects the number of knots required by the spline, which is ") + (text . "given in the B-spline representation \htbitmap{e02daf}") + (text . "\newline \menuitemstyle{}\tab{2} \newline ") + (text . "Number of data points {\it m}: ") + (text . "\newline\tab{2} ") + (bcStrings (6 30 m PI)) + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} ") + (text . "Over-estimate of \htbitmap{nx} of knots \lambda of the ") + (text . "computed spline, {\it nxest}: \newline\tab{2} ") + (bcStrings (6 14 nxest PI)) + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} ") + (text . "Over-estimate of \htbitmap{ny} of knots \mu of the computed ") + (text . "spline, {\it nyest}: \newline\tab{2} ") + (bcStrings (6 14 nyest PI)) + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} \newline ") + (text . "Smoothing factor {\it s}: ") + (text . "\newline\tab{2} ") + (bcStrings (6 "10" s F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Start value: ") + (radioButtons start + ("" " Cold Start - no values needed for {\it nx,ny,lamda,wrk,iwrk}" cold) + ("" " Warm Start - uses knots found in a previous call" warm)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Ifail value: ") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'e02ddfSolve) + htShowPage() + +e02ddfSolve htPage == + m := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) + objValUnwrap htpLabelSpadValue(htPage, 'm) + nxest := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nxest) + objValUnwrap htpLabelSpadValue(htPage, 'nxest) + nyest := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nyest) + objValUnwrap htpLabelSpadValue(htPage, 'nyest) + u := nxest - 4 + v := nyest - 4 + wlist := [u,v] + w := APPLY ('MAX, wlist) + lwrk := (7*u*v + 25*w)*(w + 1) + 2*(u + v + 4*m) + 23*w + 56 + liwrk := m + 2*(nxest - 7)*(nyest - 7) + s := htpLabelInputString(htPage,'s) + initial := htpButtonValue(htPage,'start) + start := + initial = 'cold => '1 + '2 + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + (m = 30 and start = 1) => e02ddfDefaultSolve (htPage,nxest,nyest,lwrk,liwrk,s,ifail) + start = 1 => e02ddfColdSolve (htPage,m,nxest,nyest,lwrk,liwrk,s,ifail) + -- need to change as only wrk(1) is required + labelList := + "append"/[f(i) for i in 1..m] where f(i) == + prefix := ('"\newline \tab{2} ") + middle := ('"\tab{17} ") + post := ('"\tab{32} ") + end := ('"\tab{47} ") + xnam := INTERN STRCONC ('"x",STRINGIMAGE i) + ynam := INTERN STRCONC ('"y",STRINGIMAGE i) + fnam := INTERN STRCONC ('"f",STRINGIMAGE i) + wnam := INTERN STRCONC ('"w",STRINGIMAGE i) + [['text,:prefix],['bcStrings,[8, 0.0, xnam, 'F]], + ['text,:middle],['bcStrings,[8, 0.0, ynam, 'F]], + ['text,:post],['bcStrings,[8, 0.0, fnam, 'F]], + ['text,:end],['bcStrings,[8, 0.0, wnam, 'F]]] + lamdaList := + "append"/[g(i) for i in 1..nxest] where g(i) == + lnam := INTERN STRCONC ('"l",STRINGIMAGE i) + [['bcStrings,[8, 0.0, lnam, 'F]]] + prefix := ('"\blankline \menuitemstyle{} \tab{2} Values of Lamda: \newline") + lamdaList := [['text,:prefix],:lamdaList] + muList := + "append"/[h(i) for i in 1..nyest] where h(i) == + mnam := INTERN STRCONC ('"m",STRINGIMAGE i) + [['bcStrings,[8, 0.0, mnam, 'F]]] + prefix := ('"\blankline \menuitemstyle{} \tab{2} Values of Mu: \newline") + muList := [['text,:prefix],:muList] + prefix := ('"\blankline \menuitemstyle{} \tab{2} Value of nx: \newline \tab{2}") + nxList := [['text,:prefix],['bcStrings,[8, 10, 'nx, 'PI]]] + prefix := ('"\blankline \menuitemstyle{} \tab{2} Value of ny: \newline \tab{2}") + nyList := [['text,:prefix],['bcStrings,[8, 9, 'ny, 'PI]]] + prefix := ('"\blankline \menuitemstyle{} \tab{2} Value of WRK(1): \newline \tab{2}") + wList := [['text,:prefix],['bcStrings,[8, 0.0, 'wone, 'F]]] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :labelList,:lamdaList,:muList,:nxList,:nyList,:wList] + page := htInitPage('"E02DDF - Least-squares surface fit by bicubic splines with automatic knot placement, scattered data",nil) + htSay '"\menuitemstyle{}\tab{2} Values of \space{1} " + htSay '"\htbitmap{xr}: \tab{15} \menuitemstyle{}\tab{17} " + htSay '"Values of \space{1} \htbitmap{yr}: \tab{30}" + htSay '"\menuitemstyle{}\tab{32} Values of \space{1} " + htSay '"\htbitmap{fr}: \tab{45} \menuitemstyle{} " + htSay '"\tab{47} Values of \htbitmap{wr}:" + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'e02ddfWarmGen) + htpSetProperty(page,'m,m) + htpSetProperty(page,'nxest,nxest) + htpSetProperty(page,'nyest,nyest) + htpSetProperty(page,'lwrk,lwrk) + htpSetProperty(page,'liwrk,liwrk) + htpSetProperty(page,'s,s) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + + + +e02ddfColdSolve(htPage,m,nxest,nyest,lwrk,liwrk,s,ifail) == + labelList := + "append"/[f(i) for i in 1..m] where f(i) == + prefix := ('"\newline \tab{2} ") + middle := ('"\tab{17} ") + post := ('"\tab{32} ") + end := ('"\tab{47} ") + xnam := INTERN STRCONC ('"x",STRINGIMAGE i) + ynam := INTERN STRCONC ('"y",STRINGIMAGE i) + fnam := INTERN STRCONC ('"f",STRINGIMAGE i) + wnam := INTERN STRCONC ('"w",STRINGIMAGE i) + [['text,:prefix],['bcStrings,[8, 0.0, xnam, 'F]], + ['text,:middle],['bcStrings,[8, 0.0, ynam, 'F]], + ['text,:post],['bcStrings,[8, 0.0, fnam, 'F]], + ['text,:end],['bcStrings,[8, 0.0, wnam, 'F]]] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :labelList] + page := htInitPage('"E02DDF - Least-squares surface fit by bicubic splines with automatic knot placement, scattered data",nil) + htSay '"\menuitemstyle{}\tab{2} Values of \space{1} " + htSay '"\htbitmap{xr}: \tab{15} \menuitemstyle{}\tab{17} " + htSay '"Values of \space{1} \htbitmap{yr}: \tab{30}" + htSay '"\menuitemstyle{}\tab{32} Values of \space{1} " + htSay '"\htbitmap{fr}: \tab{44} \menuitemstyle{} " + htSay '"\tab{46} Values of \htbitmap{wr}:" + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'e02ddfColdGen) + htpSetProperty(page,'m,m) + htpSetProperty(page,'nxest,nxest) + htpSetProperty(page,'nyest,nyest) + htpSetProperty(page,'lwrk,lwrk) + htpSetProperty(page,'liwrk,liwrk) + htpSetProperty(page,'s,s) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +e02ddfDefaultSolve (htPage,nxest,nyest,lwrk,liwrk,s,ifail) == + m := 30 + page := htInitPage('"E02DDF - Least-squares surface fit by bicubic splines with automatic knot placement, scattered data",nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Values of \htbitmap{xr}:") + (text . "\tab{15} \menuitemstyle{} \tab{17} Values of ") + (text . "\htbitmap{yr}: \tab{30} \menuitemstyle{} \tab{32} ") + (text . "Values of \htbitmap{fr}: \tab{44} \menuitemstyle{} ") + (text . "\tab{46} Values of \htbitmap{wr}:") + (text . "\newline \tab{2} ") + (bcStrings (8 "11.16" x1 F)) + (text . "\tab{17}") + (bcStrings (8 "1.24" y1 F)) + (text . "\tab{32}") + (bcStrings (8 "22.15" f1 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w1 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "12.85" x2 F)) + (text . "\tab{17}") + (bcStrings (8 "3.06" y2 F)) + (text . "\tab{32}") + (bcStrings (8 "22.11" f2 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w2 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "19.85" x3 F)) + (text . "\tab{17}") + (bcStrings (8 "10.72" y3 F)) + (text . "\tab{32}") + (bcStrings (8 "7.97" f3 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w3 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "19.72" x4 F)) + (text . "\tab{17}") + (bcStrings (8 "1.39" y4 F)) + (text . "\tab{32}") + (bcStrings (8 "16.83" f4 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w4 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "15.91" x5 F)) + (text . "\tab{17}") + (bcStrings (8 "7.74" y5 F)) + (text . "\tab{32}") + (bcStrings (8 "15.30" f5 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w5 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "0" x6 F)) + (text . "\tab{17}") + (bcStrings (8 "20" y6 F)) + (text . "\tab{32}") + (bcStrings (8 "34.6" f6 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w6 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "20.87" x7 F)) + (text . "\tab{17}") + (bcStrings (8 "20" y7 F)) + (text . "\tab{32}") + (bcStrings (8 "5.74" f7 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w7 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "3.45" x8 F)) + (text . "\tab{17}") + (bcStrings (8 "12.78" y8 F)) + (text . "\tab{32}") + (bcStrings (8 "41.24" f8 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w8 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "14.26" x9 F)) + (text . "\tab{17}") + (bcStrings (8 "17.87" y9 F)) + (text . "\tab{32}") + (bcStrings (8 "10.74" f9 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w9 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "17.43" x10 F)) + (text . "\tab{17}") + (bcStrings (8 "3.46" y10 F)) + (text . "\tab{32}") + (bcStrings (8 "18.60" f10 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w10 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "22.8" x11 F)) + (text . "\tab{17}") + (bcStrings (8 "12.39" y11 F)) + (text . "\tab{32}") + (bcStrings (8 "5.47" f11 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w11 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "7.58" x12 F)) + (text . "\tab{17}") + (bcStrings (8 "1.98" y12 F)) + (text . "\tab{32}") + (bcStrings (8 "29.87" f12 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w12 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "25" x13 F)) + (text . "\tab{17}") + (bcStrings (8 "11.87" y13 F)) + (text . "\tab{32}") + (bcStrings (8 "4.4" f13 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w13 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "0" x14 F)) + (text . "\tab{17}") + (bcStrings (8 "0" y14 F)) + (text . "\tab{32}") + (bcStrings (8 "58.2" f14 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w14 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "9.66" x15 F)) + (text . "\tab{17}") + (bcStrings (8 "20" y15 F)) + (text . "\tab{32}") + (bcStrings (8 "4.73" f15 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w15 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "5.22" x16 F)) + (text . "\tab{17}") + (bcStrings (8 "14.66" y16 F)) + (text . "\tab{32}") + (bcStrings (8 "40.36" f16 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w16 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "17.25" x17 F)) + (text . "\tab{17}") + (bcStrings (8 "19.57" y17 F)) + (text . "\tab{32}") + (bcStrings (8 "6.43" f17 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w17 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "25" x18 F)) + (text . "\tab{17}") + (bcStrings (8 "3.87" y18 F)) + (text . "\tab{32}") + (bcStrings (8 "8.74" f18 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w18 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "12.13" x19 F)) + (text . "\tab{17}") + (bcStrings (8 "10.79" y19 F)) + (text . "\tab{32}") + (bcStrings (8 "13.71" f19 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w19 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "22.23" x20 F)) + (text . "\tab{17}") + (bcStrings (8 "6.21" y20 F)) + (text . "\tab{32}") + (bcStrings (8 "10.25" f20 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w20 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "11.52" x21 F)) + (text . "\tab{17}") + (bcStrings (8 "8.53" y21 F)) + (text . "\tab{32}") + (bcStrings (8 "15.74" f21 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w21 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "15.2" x22 F)) + (text . "\tab{17}") + (bcStrings (8 "0" y22 F)) + (text . "\tab{32}") + (bcStrings (8 "21.6" f22 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w22 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "7.54" x23 F)) + (text . "\tab{17}") + (bcStrings (8 "10.69" y23 F)) + (text . "\tab{32}") + (bcStrings (8 "19.31" f23 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w23 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "17.32" x24 F)) + (text . "\tab{17}") + (bcStrings (8 "13.78" y24 F)) + (text . "\tab{32}") + (bcStrings (8 "12.11" f24 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w24 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "2.14" x25 F)) + (text . "\tab{17}") + (bcStrings (8 "15.03" y25 F)) + (text . "\tab{32}") + (bcStrings (8 "53.1" f25 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w25 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "0.51" x26 F)) + (text . "\tab{17}") + (bcStrings (8 "8.37" y26 F)) + (text . "\tab{32}") + (bcStrings (8 "49.43" f26 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w26 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "22.69" x27 F)) + (text . "\tab{17}") + (bcStrings (8 "19.63" y27 F)) + (text . "\tab{32}") + (bcStrings (8 "3.25" f27 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w27 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "5.47" x28 F)) + (text . "\tab{17}") + (bcStrings (8 "17.13" y28 F)) + (text . "\tab{32}") + (bcStrings (8 "28.63" f28 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w28 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "21.67" x29 F)) + (text . "\tab{17}") + (bcStrings (8 "14.36" y29 F)) + (text . "\tab{32}") + (bcStrings (8 "5.52" f29 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w29 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "3.31" x30 F)) + (text . "\tab{17}") + (bcStrings (8 "0.33" y30 F)) + (text . "\tab{32}") + (bcStrings (8 "44.08" f30 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w30 F)) + (text . "\blankline")) + htMakeDoneButton('"Continue",'e02ddfColdGen) + htpSetProperty(page,'m,m) + htpSetProperty(page,'nxest,nxest) + htpSetProperty(page,'nyest,nyest) + htpSetProperty(page,'lwrk,lwrk) + htpSetProperty(page,'liwrk,liwrk) + htpSetProperty(page,'s,s) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +e02ddfColdGen htPage == + m := htpProperty(htPage,'m) + nxest := htpProperty(htPage,'nxest) + nyest := htpProperty(htPage,'nyest) + lwrk := htpProperty(htPage,'lwrk) + liwrk := htpProperty(htPage,'liwrk) + s := htpProperty(htPage,'s) + cold := '"c" + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + while y repeat + end := STRCONC ((first y).1," ") + y := rest y + right := STRCONC ((first y).1," ") + y := rest y + mid := STRCONC ((first y).1," ") + y := rest y + left := STRCONC ((first y).1," ") + y := rest y + xlist := [left,:xlist] + ylist := [mid,:ylist] + flist := [right,:flist] + wlist := [end,:wlist] + xstring := bcwords2liststring xlist + ystring := bcwords2liststring ylist + fstring := bcwords2liststring flist + wstring := bcwords2liststring wlist + -- additional entries nx,ny,lamda,mu,wrk needed to get it running + -- but they are just set to 0.0 + prefix := STRCONC('"e02ddf(_"",cold,"_",",STRINGIMAGE m,", [",xstring,"],[") + prefix := STRCONC(prefix,ystring,"],[",fstring,"],[",wstring,"], ") + prefix := STRCONC(prefix,STRINGIMAGE s,", ",STRINGIMAGE nxest,", ") + prefix := STRCONC(prefix,STRINGIMAGE nyest,", ",STRINGIMAGE lwrk,", ") + prefix := STRCONC(prefix,STRINGIMAGE liwrk,", 0,") + prefix := STRCONC(prefix,"new(1,", STRINGIMAGE nxest,",0.0)$MATRIX DFLOAT,0,") + prefix := STRCONC(prefix,"new(1,", STRINGIMAGE nyest,",0.0)$MATRIX DFLOAT,") + prefix := STRCONC(prefix,"new(1,", STRINGIMAGE lwrk,",0.0)$MATRIX DFLOAT,") +-- prefix := STRCONC(prefix,"[[0.0 for i in 1..", STRINGIMAGE nxest,"]],0,") +-- prefix := STRCONC(prefix,"[[0.0 for i in 1..", STRINGIMAGE nyest,"]],") +-- prefix := STRCONC(prefix,"[[0.0 for i in 1..", STRINGIMAGE lwrk,"]],") + prefix := STRCONC(prefix,STRINGIMAGE ifail,")") + linkGen prefix + +e02ddfWarmGen htPage == + m := htpProperty(htPage,'m) + nxest := htpProperty(htPage,'nxest) + nyest := htpProperty(htPage,'nyest) + lwrk := htpProperty(htPage,'lwrk) + liwrk := htpProperty(htPage,'liwrk) + s := htpProperty(htPage,'s) + warm := '"w" + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + wrk := (first y).1 + y := rest y + for i in 1..lwrk repeat + wrkList := ['"0.0 ",:wrkList] + wrkList := [wrk,:wrkList] + wrkstring := bcwords2liststring wrkList + ny := STRCONC((first y).1," ") + y := rest y + nx := STRCONC((first y).1," ") + y := rest y + for i in 1..nyest repeat + mu := STRCONC ((first y).1, " ") + y := rest y + muList := [mu,:muList] + mustring := bcwords2liststring muList + for i in 1..nxest repeat + lam := STRCONC ((first y).1, " ") + y := rest y + lamList := [lam,:lamList] + lamstring := bcwords2liststring lamList + while y repeat + end := STRCONC ((first y).1," ") + y := rest y + right := STRCONC ((first y).1," ") + y := rest y + mid := STRCONC ((first y).1," ") + y := rest y + left := STRCONC ((first y).1," ") + y := rest y + xlist := [left,:xlist] + ylist := [mid,:ylist] + flist := [right,:flist] + wlist := [end,:wlist] + xstring := bcwords2liststring xlist + ystring := bcwords2liststring ylist + fstring := bcwords2liststring flist + wstring := bcwords2liststring wlist + -- additional entries nx,ny,lamda,mu,wrk needed to get it running + -- but they are just set to 0.0 + prefix := STRCONC('"e02ddf(_"",warm,"_",",STRINGIMAGE m,", [",xstring,"],[") + prefix := STRCONC(prefix,ystring,"],[",fstring,"],[",wstring,"], ") + prefix := STRCONC(prefix,STRINGIMAGE s,", ",STRINGIMAGE nxest,", ") + prefix := STRCONC(prefix,STRINGIMAGE nyest,", ",STRINGIMAGE lwrk,", ") + prefix := STRCONC(prefix,STRINGIMAGE liwrk,", ",nx,",[",lamstring,"],",ny) + prefix := STRCONC(prefix,",[",mustring,"],[",wrkstring,"],") + prefix := STRCONC(prefix,STRINGIMAGE ifail,")") + linkGen prefix + +e02zaf() == + htInitPage('"E02ZAF - Sort 2-D sata into panels for fitting bicubic splines",nil) + htMakePage '( + (domainConditions + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXe02zaf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02zaf| '|NagFittingPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "Sorts the set of points {\em (\htbitmap{xr},") + (text . "\htbitmap{yr})} into panels defined by \space{1}") + (text . "\htbitmap{px} -8 points \htbitmap{lamdai} ") + (text . "on the x-axis and \space{1}\htbitmap{py}-8 points ") + (text . "\htbitmap{muj} on the y axis. The points are ordered ") + (text . "so that all points in a panel occur before data in succeeding ") + (text . "panels. Within a panel, the points maintain their original ") + (text . "order. ") + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} \newline ") + (text . "Number of points to be sorted to be sorted {\it m}: ") + (text . "\newline\tab{2} ") + (bcStrings (6 10 m PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "\newline Intercepts + 8 on x axis {\em px}:") + (text . "\tab{32} \menuitemstyle{}\tab{34}") + (text . "Intercepts + 8 on y axis {\em py}:") + (text . "\newline\tab{2} ") + (bcStrings (6 9 px PI)) + (text . "\tab{34} ") + (bcStrings (6 10 py PI)) + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} \newline ") + (text . "Dimension of point {\it npoint}: ") + (text . "\newline\tab{2} ") + (bcStrings (6 45 npoint PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Ifail value: ") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'e02zafSolve) + htShowPage() + +e02zafSolve htPage == + m := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) + objValUnwrap htpLabelSpadValue(htPage, 'm) + px := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'px) + objValUnwrap htpLabelSpadValue(htPage, 'px) + py := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'py) + objValUnwrap htpLabelSpadValue(htPage, 'py) + npoint := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'npoint) + objValUnwrap htpLabelSpadValue(htPage, 'npoint) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + ((m = '10 and px = '9) and py = '10) => e02zafDefaultSolve(htPage,npoint,ifail) + labelList := + "append"/[fxy(i) for i in 1..m] where fxy(i) == + prefix := ('"\newline \tab{2} ") + middle := ('"\tab{32} ") + lnam := INTERN STRCONC ('"x",STRINGIMAGE i) + cnam := INTERN STRCONC ('"y",STRINGIMAGE i) + [['text,:prefix],['bcStrings,[8, 0.0, lnam, 'F]], + ['text,:middle],['bcStrings,[8, 0.0, cnam, 'F]]] + lamList := + "append"/[flam(i) for i in 5..(px-4)] where flam(i) == + lnam := INTERN STRCONC ('"l",STRINGIMAGE i) + [['bcStrings,[8, 0.0, lnam, 'F]]] + prefix := ('"\blankline \menuitemstyle{} \tab{2} {\it \lambda(5) to ") + prefix := STRCONC(prefix,"\lambda(px-4)}: \newline \tab{2} ") + lamList := [['text,:prefix],:lamList] + muList := + "append"/[fmu(i) for i in 5..(py-4)] where fmu(i) == + mnam := INTERN STRCONC ('"m",STRINGIMAGE i) + [['bcStrings,[8, 0.0, mnam, 'F]]] + prefix := ('"\blankline \menuitemstyle{} \tab{2} {\it \mu(5) to \mu(py-4)}: ") + prefix := STRCONC(prefix,"\newline \tab{2} ") + muList := [['text,:prefix],:muList] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :labelList,:lamList,:muList] + page := htInitPage('"E02ZAF - Sort 2-D sata into panels for fitting bicubic splines",nil) + htSay '"\menuitemstyle{}\tab{2} {\it x(m)}: " + htSay '"\tab{30} \menuitemstyle{}\tab{32} {\it y(m)}: " + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'e02zafGen) + htpSetProperty(page,'m,m) + htpSetProperty(page,'px,px) + htpSetProperty(page,'py,py) + htpSetProperty(page,'npoint,npoint) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +e02zafDefaultSolve (htPage,npoint,ifail) == + m := '10 + px := '9 + py := '10 + page := htInitPage('"E02ZAF - Sort 2-D sata into panels for fitting bicubic splines",nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} {\it x(m)}:") + (text . "\tab{30} \menuitemstyle{} \tab{32} {\it y(m)}:") + (text . "\newline \tab{2} ") + (bcStrings (8 "0.00" x1 F)) + (text . "\tab{32}") + (bcStrings (8 "0.77" y1 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "0.70" x2 F)) + (text . "\tab{32}") + (bcStrings (8 "1.06" y2 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "1.44" x3 F)) + (text . "\tab{32}") + (bcStrings (8 "0.33" y3 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "0.21" x4 F)) + (text . "\tab{32}") + (bcStrings (8 "0.44" y4 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "1.01" x5 F)) + (text . "\tab{32}") + (bcStrings (8 "0.50" y5 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "1.84" x6 F)) + (text . "\tab{32}") + (bcStrings (8 "0.02" y6 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "0.71" x7 F)) + (text . "\tab{32}") + (bcStrings (8 "1.95" y7 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "1.00" x8 F)) + (text . "\tab{32}") + (bcStrings (8 "1.20" y8 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "0.54" x9 F)) + (text . "\tab{32}") + (bcStrings (8 "0.04" y9 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "1.531" x10 F)) + (text . "\tab{32}") + (bcStrings (8 "0.18" y10 F)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2} {\it \lambda(5) to \lambda(px-4)}:") + (text . "\newline \tab{2}") + (bcStrings (8 "1.00" l5 F)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2} {\it \mu(5) to \mu(py-4)}:") + (text . "\newline \tab{2}") + (bcStrings (8 "0.80" mu5 F)) + (bcStrings (8 "1.20" mu6 F)) + (text . "\blankline ")) + htMakeDoneButton('"Continue",'e02zafGen) + htpSetProperty(page,'m,m) + htpSetProperty(page,'px,px) + htpSetProperty(page,'py,py) + htpSetProperty(page,'npoint,npoint) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +e02zafGen htPage == + m := htpProperty(htPage,'m) + px := htpProperty(htPage,'px) + py := htpProperty(htPage,'py) + npoint := htpProperty(htPage,'npoint) + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + nadres := (px-7)*(py-7) + -- mu + for i in 1..4 repeat + muList := ['"0 ",:muList] + for i in 5..(py-4) repeat + right := STRCONC ((first y).1," ") + y := rest y + muList := [right,:muList] + for i in (py-3)..py repeat + muList := ['"0 ",:muList] + mustring := bcwords2liststring muList + -- lamda + for i in 1..4 repeat + lamList := ['"0 ",:lamList] + for i in 5..(px-4) repeat + right := STRCONC ((first y).1," ") + y := rest y + lamList := [right,:lamList] + for i in (px-3)..px repeat + lamList := ['"0 ",:lamList] + lamstring := bcwords2liststring lamList + -- x & y + while y repeat + right := STRCONC ((first y).1," ") + y := rest y + left := STRCONC ((first y).1," ") + y := rest y + xlist := [left,:xlist] + ylist := [right,:ylist] + xstring := bcwords2liststring xlist + ystring := bcwords2liststring ylist + prefix := STRCONC('"e02zaf(",STRINGIMAGE px,", ",STRINGIMAGE py,",[") + prefix := STRCONC(prefix,lamstring,"],[",mustring,"], ",STRINGIMAGE m,", [") + prefix := STRCONC(prefix,xstring,"],[",ystring,"], ",STRINGIMAGE npoint,", ") + prefix := STRCONC(prefix,STRINGIMAGE nadres,", ",STRINGIMAGE ifail,")") + linkGen prefix + + + diff --git a/src/interp/nag-e02.boot.pamphlet b/src/interp/nag-e02.boot.pamphlet deleted file mode 100644 index a1f2e843..00000000 --- a/src/interp/nag-e02.boot.pamphlet +++ /dev/null @@ -1,4695 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp nag-e02.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. - -@ -<<*>>= -<> - -)package "BOOT" - -e02adf() == - htInitPage('"E02ADF - Least-squares curve fit, by polynomials, arbitrary data points", nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXe02adf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02adf| '|NagFittingPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "Determines weighted least-squares polynomial approximations of ") - (text . "degrees 0,1,...,k to the set of points {\it (} ") - (text . "\htbitmap{xr}, \htbitmap{yr}{\it )} ") - (text . "with weights \htbitmap{wr}, for r = 1,2,...,m. ") - (text . "The polynomials are in the Chebyshev series form, the ") - (text . "approximation of degree {\it i} being represented as ") - (text . "\newline \center{\htbitmap{e02adf}} , where ") - (text . "\htbitmap{xbar} is the normalised argument, which is ") - (text . "related to the original variable {\it x} by the transformation ") - (text . "\blankline \center{\htbitmap{e02adf1}} ") - (text . ",\htbitmap{xmin} and \htbitmap{xmax} being ") - (text . "the values of \htbitmap{xr} respectively ") - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} \newline ") - (text . "Number of data points {\it m}:") - (text . "\newline \tab{2} ") - (bcStrings (6 11 m PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Maximum degree required {\it k}:") - (text . "\newline \tab{2} ") - (bcStrings (6 3 k PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} \newline ") - (text . "First dimension of A, {\it nrows} \htbitmap{great=} {\it k+1}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 50 nrows I)) - (text . "\blankline") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'e02adfSolve) - htShowPage() - -e02adfSolve htPage == - m := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) - objValUnwrap htpLabelSpadValue(htPage, 'm) - k := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'k) - objValUnwrap htpLabelSpadValue(htPage, 'k) - nrows := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nrows) - objValUnwrap htpLabelSpadValue(htPage, 'nrows) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - (m = '11 and k ='3) => e02adfDefaultSolve(htPage,k,nrows,ifail) - labelList := - "append"/[f(i) for i in 1..m] where f(i) == - prefix := ('"\newline \tab{2} ") - middle := ('"\tab{22} ") - post := ('" \tab{42} ") - xnam := INTERN STRCONC ('"x",STRINGIMAGE i) - ynam := INTERN STRCONC ('"y",STRINGIMAGE i) - znam := INTERN STRCONC ('"z",STRINGIMAGE i) - num := INTERN STRCONC (STRINGIMAGE (QUOTIENT(i,10)),".",STRINGIMAGE (REM(i,10))) - [['text,:prefix],['bcStrings,[10, num, xnam, 'F]], - ['text,:middle],['bcStrings,[10, 0.0, ynam, 'F]], - ['text,:post],['bcStrings,[10, 0.0, znam, 'F]]] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :labelList] - page := htInitPage("E02ADF - Least-squares curve fit, by polynomials, arbitrary data points", htpPropertyList htPage) - htSay '"\menuitemstyle{}\tab{2} Values of \space{1} " - htSay '"\htbitmap{xr}: \tab{20} \menuitemstyle{}\tab{22} " - htSay '"Values of \space{1} \htbitmap{fr}: \tab{40}" - htSay '"\menuitemstyle{}\tab{42} Values of \space{1} " - htSay '"\htbitmap{dr}: " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'e02adfGen) - htpSetProperty(page,'m,m) - htpSetProperty(page,'k,k) - htpSetProperty(page,'nrows,nrows) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -e02adfDefaultSolve (htPage,k,nrows,ifail) == - m := '11 - page := htInitPage('"E02ADF - Least-squares curve fit, by polynomials, arbitrary data points", htpPropertyList htPage) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Values of \space{1} ") - (text . "\htbitmap{xr}: \tab{20} \menuitemstyle{}\tab{22} ") - (text . "Values of \space{1} \htbitmap{yr}: \tab{40} ") - (text . "\menuitemstyle{}\tab{42} Values of \space{1} ") - (text . "\htbitmap{wr}: ") - (text . "\newline \tab{2}") - (bcStrings (10 "1.00" x1 F)) - (text . "\tab{22} ") - (bcStrings (10 "10.40" y1 F)) - (text . "\tab{42} ") - (bcStrings (10 "1.00" z1 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "2.10" x2 F)) - (text . "\tab{22} ") - (bcStrings (10 "7.90" y2 F)) - (text . "\tab{42} ") - (bcStrings (10 "1.00" z2 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "3.10" x3 F)) - (text . "\tab{22} ") - (bcStrings (10 "4.70" y3 F)) - (text . "\tab{42} ") - (bcStrings (10 "1.00" z3 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "3.90" x4 F)) - (text . "\tab{22} ") - (bcStrings (10 "2.50" y4 F)) - (text . "\tab{42} ") - (bcStrings (10 "1.00" z4 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "4.90" x5 F)) - (text . "\tab{22} ") - (bcStrings (10 "1.20" y5 F)) - (text . "\tab{42} ") - (bcStrings (10 "1.00" z5 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "5.80" x6 F)) - (text . "\tab{22} ") - (bcStrings (10 "2.20" y6 F)) - (text . "\tab{42} ") - (bcStrings (10 "0.80" z6 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "6.50" x7 F)) - (text . "\tab{22} ") - (bcStrings (10 "5.10" y7 F)) - (text . "\tab{42} ") - (bcStrings (10 "0.80" z7 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "7.10" x8 F)) - (text . "\tab{22} ") - (bcStrings (10 "9.20" y8 F)) - (text . "\tab{42} ") - (bcStrings (10 "0.70" z8 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "7.80" x9 F)) - (text . "\tab{22} ") - (bcStrings (10 "16.10" y9 F)) - (text . "\tab{42} ") - (bcStrings (10 "0.50" z9 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "8.40" x10 F)) - (text . "\tab{22} ") - (bcStrings (10 "24.50" y10 F)) - (text . "\tab{42} ") - (bcStrings (10 "0.30" z10 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "9.00" x11 F)) - (text . "\tab{22} ") - (bcStrings (10 "35.30" y11 F)) - (text . "\tab{42} ") - (bcStrings (10 "0.20" z11 F)) - (text . "\blankline")) - htMakeDoneButton('"Continue",'e02adfGen) - htpSetProperty(page,'m,m) - htpSetProperty(page,'k,k) - htpSetProperty(page,'nrows,nrows) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -e02adfGen htPage == - m := htpProperty(htPage,'m) - k := htpProperty(htPage,'k) - nrows := htpProperty(htPage,'nrows) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - kplus1 := k + 1 - y := alist - while y repeat - right := STRCONC ((first y).1," ") - y := rest y - mid := STRCONC ((first y).1," ") - y := rest y - left := STRCONC ((first y).1," ") - y := rest y - xlist := [left,:xlist] - ylist := [mid,:ylist] - wlist := [right,:wlist] - xstring := bcwords2liststring xlist - ystring := bcwords2liststring ylist - wstring := bcwords2liststring wlist - prefix := STRCONC('"e02adf(",STRINGIMAGE m,", ",STRINGIMAGE kplus1,", ") - prefix := STRCONC(prefix,STRINGIMAGE nrows,", [",xstring,"],[",ystring,"],[") - prefix := STRCONC(prefix,wstring,"],",STRINGIMAGE ifail,")") - linkGen prefix - -e02aef() == - htInitPage('"E02AEF - Evaluation of fitted polynomial in one variable from Chebyshev series form", nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXe02aef} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02aef| '|NagFittingPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "Evaluates a polynomial in Chabyshev series representation ") - (text . "\newline \center{\htbitmap{e02aef}} ") - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} \newline ") - (text . "Number of terms in the series {\it n}:") - (text . "\newline \tab{2} ") - (bcStrings (6 4 n PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "\htbitmap{xbar}: ") - (text . " \newline \tab{2} ") - (bcStrings (6 "-1.0" xcap F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'e02aefSolve) - htShowPage() - -e02aefSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - xcap := htpLabelInputString(htPage,'xcap) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - n = '4 => e02aefDefaultSolve(htPage,xcap,ifail) - labelList := - "append"/[f(i) for i in 1..(n+1)] where f(i) == - prefix := ('"\newline \tab{15} ") - anam := INTERN STRCONC ('"a",STRINGIMAGE i) - [['text,:prefix],['bcStrings,[10, 0.0, anam, 'F]]] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :labelList] - page := htInitPage("E02AEF - Evaluation of fitted polynomial in one variable from Chebyshev series from", nil) - htSay '"\menuitemstyle{}\tab{2} Enter the coefficients of {\it a(n+1)}:" - htSay '"\blankline " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'e02aefGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'xcap,xcap) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -e02aefDefaultSolve (htPage,xcap,ifail) == - n := '4 - page := htInitPage('"E02AEF - Evaluation of fitted polynomial in one variable from Chebyshev series form", nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Enter the coeffients of {\it a(n+1)}: ") - (text . "\blankline ") - (text . "\newline \tab{15} ") - (bcStrings (10 "2.0000" a1 F)) - (text . "\newline \tab{15} ") - (bcStrings (10 "0.5000" a2 F)) - (text . "\newline \tab{15} ") - (bcStrings (10 "0.2500" a3 F)) - (text . "\newline \tab{15} ") - (bcStrings (10 "0.1250" a4 F)) - (text . "\newline \tab{15} ") - (bcStrings (10 "0.0625" a5 F)) - (text . "\blankline ")) - htMakeDoneButton('"Continue",'e02aefGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'xcap,xcap) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -e02aefGen htPage == - n := htpProperty(htPage,'n) - xcap := htpProperty(htPage,'xcap) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - nplus1 := n + 1 - y := alist - while y repeat - right := STRCONC ((first y).1," ") - y := rest y - arrayList := [right,:arrayList] - astring := bcwords2liststring arrayList - prefix := STRCONC('"e02aef(",STRINGIMAGE nplus1,", [",astring ,"], ") - prefix := STRCONC(prefix,STRINGIMAGE xcap,", ",STRINGIMAGE ifail,")") - linkGen prefix - -e02agf() == - htInitPage('"E02AGF - Least-squares polynomial fit, values and derivatives may be constrained, arbitrary data values",nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXe02agf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02agf| '|NagFittingPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "Determines constrained least-squares polynomial approximations ") - (text . "to the set of points {\it (\htbitmap{xr},\htbitmap{yr})} with ") - (text . "weights \htbitmap{wr}, for r = 1,2,...,m. The values of the ") - (text . "approximations and any number of their derivatives must be ") - (text . "specified at a further set of points \htbitmap{xii}, ") - (text . "for i = 1,2,...,{\it mf}. The total number of interpolating ") - (text . "conditions is given by \center{\htbitmap{e02agf}} where ") - (text . "\htbitmap{pi} is the highest order derivative ") - (text . "specified at point \htbitmap{xii}. The values ") - (text . "\htbitmap{xr} and \htbitmap{xii} all lie ") - (text . "in the interval [\htbitmap{xmin},") - (text . "\htbitmap{xmax}]. The polynomials are given in ") - (text . "Chebyshev series form, the approximation of degree {\it i} being") - (text . " represented as\blankline \center{\htbitmap{e02agf1}}") - (text . "\newline, where \htbitmap{xbar} is the normalised ") - (text . "argument, related to the original variable {\it x} by the ") - (text . "transformation \newline \center{\htbitmap{e02adf1}} ") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "\newline Number of data points {\it m}:") - (text . "\tab{32} \menuitemstyle{}\tab{34}") - (text . "Maximum degree required {\it k}:") - (text . "\newline\tab{2} ") - (bcStrings (6 5 m PI)) - (text . "\tab{34} ") - (bcStrings (6 4 k PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} \newline ") - (text . "First dimension of A, {\it nrows \htbitmap{great=} k+1}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 6 nrows I)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "\newline \htbitmap{xmin}: ") - (text . "\tab{32} \menuitemstyle{}\tab{34}") - (text . "\htbitmap{xmax}: ") - (text . "\newline\tab{2} ") - (bcStrings (6 "0.0" xmin F)) - (text . "\tab{34} ") - (bcStrings (6 "4.0" xmax F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "\newline Dimension of {\it xf} & {\it ip}, {\it mf}: ") - (text . "\tab{32} \menuitemstyle{}\tab{34}") - (text . "Dimension of {\it yf}, {\it lyf}:") - (text . "\newline\tab{2} ") - (bcStrings (6 2 mf PI)) - (text . "\tab{34} ") - (bcStrings (6 15 lyf PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'e02agfSolve) - htShowPage() - -e02agfSolve htPage == - m := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) - objValUnwrap htpLabelSpadValue(htPage, 'm) - k := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'k) - objValUnwrap htpLabelSpadValue(htPage, 'kplus1) - nrows := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nrows) - objValUnwrap htpLabelSpadValue(htPage, 'nrows) - xmin := htpLabelInputString(htPage,'xmin) - xmax := htpLabelInputString(htPage,'xmax) - mf := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'mf) - objValUnwrap htpLabelSpadValue(htPage, 'mf) - lyf := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lyf) - objValUnwrap htpLabelSpadValue(htPage, 'lyf) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - (m = '5 and k ='4 and mf = '2 and lyf = '15) => e02agfDefaultSolve(htPage,nrows,xmin,xmax,ifail) - labelList := - "append"/[f(i) for i in 1..m] where f(i) == - prefix := ('"\newline \tab{2} ") - middle := ('"\tab{22} ") - post := ('" \tab{42} ") - xnam := INTERN STRCONC ('"x",STRINGIMAGE i) - ynam := INTERN STRCONC ('"y",STRINGIMAGE i) - znam := INTERN STRCONC ('"z",STRINGIMAGE i) - num := INTERN STRCONC (STRINGIMAGE (QUOTIENT(i,10)),".",STRINGIMAGE (REM(i,10))) - [['text,:prefix],['bcStrings,[10, num, xnam, 'F]], - ['text,:middle],['bcStrings,[10, 0.0, ynam, 'F]], - ['text,:post],['bcStrings,[10, 0.0, znam, 'F]]] - xfList := - "append"/[g(j) for j in 1..mf] where g(j) == - xfnam := INTERN STRCONC ('"xf",STRINGIMAGE j) - [['bcStrings,[6, 0.0, xfnam, 'F]]] - prefix := ('"\blankline \newline \menuitemstyle{}\tab{2} Values of ") - prefix := STRCONC(prefix,"{\it xf}: \newline \tab{2} ") - xfList := [['text,:prefix],:xfList] - ipList := - "append"/[h(k) for k in 1..mf] where h(k) == - ipnam := INTERN STRCONC ('"ip",STRINGIMAGE k) - [['bcStrings,[6, 0, ipnam, 'PI]]] - prefix := ('"\blankline \newline \menuitemstyle{}\tab{2} Values of ") - prefix := STRCONC(prefix,"{\it ip}: \newline \tab{2} ") - ipList := [['text,:prefix],:ipList] - yfList := - "append"/[i(l) for l in 1..lyf] where i(l) == - prefix := ('"\newline \tab{2} ") - yfnam := INTERN STRCONC ('"lyf",STRINGIMAGE l) - [['text,:prefix],['bcStrings,[10, 0.0, yfnam, 'F]]] - prefix := ('"\blankline \newline \menuitemstyle{}\tab{2} Values of ") - prefix := STRCONC(prefix,"{\it yf}: \newline \tab{2} ") - yfList := [['text,:prefix],:yfList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :labelList,:xfList,:ipList,:yfList] - page := htInitPage("E02AGF - Least-squares polynomial fit, values and derivatives may be constrained, arbitrary data values",nil) - htSay '"\menuitemstyle{}\tab{2} Values of \space{1} " - htSay '"\htbitmap{xr}: \tab{20} \menuitemstyle{}\tab{22} " - htSay '"Values of \space{1} \htbitmap{yr}: \tab{40}" - htSay '"\menuitemstyle{}\tab{42} Values of \space{1} " - htSay '"\htbitmap{wr}: " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'e02agfGen) - htpSetProperty(page,'m,m) - htpSetProperty(page,'k,k) - htpSetProperty(page,'nrows,nrows) - htpSetProperty(page,'nrows,nrows) - htpSetProperty(page,'xmin,xmin) - htpSetProperty(page,'xmax,xmax) - htpSetProperty(page,'mf,mf) - htpSetProperty(page,'lyf,lyf) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -e02agfDefaultSolve (htPage,nrows,xmin,xmax,ifail) == - m := '5 - k := '4 - mf := '2 - lyf := '15 - page := htInitPage('"E02AGF - Least-squares polynomial fit, values and derivativesby polynomials, arbitrary data points", htpPropertyList htPage) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\menuitemstyle{}\tab{2} Values of \space{1} ") - (text . "\htbitmap{xr}: \tab{20} \menuitemstyle{}\tab{22} ") - (text . "Values of \space{1} \htbitmap{yr}: \tab{40} ") - (text . "\menuitemstyle{}\tab{42} Values of \space{1} ") - (text . "\htbitmap{wr}: ") - (text . "\newline \tab{2}") - (bcStrings (10 "0.5" x1 F)) - (text . "\tab{22} ") - (bcStrings (10 "0.03" y1 F)) - (text . "\tab{42} ") - (bcStrings (10 "1.0" z1 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "1.0" x2 F)) - (text . "\tab{22} ") - (bcStrings (10 "-0.75" y2 F)) - (text . "\tab{42} ") - (bcStrings (10 "1.0" z2 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "2.0" x3 F)) - (text . "\tab{22} ") - (bcStrings (10 "-1.0" y3 F)) - (text . "\tab{42} ") - (bcStrings (10 "1.0" z3 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "2.5" x4 F)) - (text . "\tab{22} ") - (bcStrings (10 "-0.1" y4 F)) - (text . "\tab{42} ") - (bcStrings (10 "1.0" z4 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "3.0" x5 F)) - (text . "\tab{22} ") - (bcStrings (10 "1.75" y5 F)) - (text . "\tab{42} ") - (bcStrings (10 "1.0" z5 F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Values of {\it xf}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" xf1 F)) - (bcStrings (6 "4.0" xf2 F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Values of {\it ip}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 1 ip1 PI)) - (bcStrings (6 0 ip2 PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Values of {\it yf}: ") - (text . "\newline \tab{2} ") - (bcStrings (10 "1.0" lyf1 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "-2.0" lyf2 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "9.0" lyf3 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.0" lyf4 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.0" lyf5 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.0" lyf6 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.0" lyf7 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.0" lyf8 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.0" lyf9 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.0" lyf10 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.0" lyf11 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.0" lyf12 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.0" lyf13 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.0" lyf14 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.0" lyf15 F))) - htMakeDoneButton('"Continue",'e02agfGen) - htpSetProperty(page,'m,m) - htpSetProperty(page,'k,k) - htpSetProperty(page,'nrows,nrows) - htpSetProperty(page,'xmin,xmin) - htpSetProperty(page,'xmax,xmax) - htpSetProperty(page,'mf,mf) - htpSetProperty(page,'lyf,lyf) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -e02agfGen htPage == - m := htpProperty(htPage,'m) - k := htpProperty(htPage,'k) - nrows := htpProperty(htPage,'nrows) - xmin := htpProperty(htPage,'xmin) - xmax := htpProperty(htPage,'xmax) - mf := htpProperty(htPage,'mf) - lyf := htpProperty(htPage,'lyf) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - kplus1 := k + 1 - ipsum := 0 - y := alist - for i in 1..lyf repeat - yf := STRCONC((first y).1," ") - yfList := [yf,:yfList] - y := rest y - yfstring := bcwords2liststring yfList - for i in 1..mf repeat - iptest := (first y).1 - iptestval := READ_-FROM_-STRING(iptest) - ipsum := ipsum + iptestval - ip := STRCONC(iptest," ") - iptestList := [iptestval,:iptestList] - ipList := [ip,:ipList] - y := rest y - ipstring := bcwords2liststring ipList - ipmax := APPLY ('MAX, iptestList) - n := mf + ipsum - for i in 1..mf repeat - xf := STRCONC((first y).1," ") - xfList := [xf,:xfList] - y := rest y - xfstring := bcwords2liststring xfList - while y repeat - right := STRCONC ((first y).1," ") - y := rest y - mid := STRCONC ((first y).1," ") - y := rest y - left := STRCONC ((first y).1," ") - y := rest y - xlist := [left,:xlist] - ylist := [mid,:ylist] - wlist := [right,:wlist] - xstring := bcwords2liststring xlist - ystring := bcwords2liststring ylist - wstring := bcwords2liststring wlist - wrktest1 := 4*m + 3*kplus1 - wrktest2 := 8*n + 5*ipmax + mf +10 - wrktestlist := [wrktest1,wrktest2] - wrkmax := APPLY ('MAX, wrktestlist) - lwrk := wrkmax + 2*n + 2 - liwrk := 2*mf + 2 - prefix := STRCONC('"e02agf(",STRINGIMAGE m,", ",STRINGIMAGE kplus1,", ") - prefix := STRCONC(prefix,STRINGIMAGE nrows,", ",xmin,", ",xmax,", [",xstring) - prefix := STRCONC(prefix,"],[",ystring,"],[",wstring,"],",STRINGIMAGE mf) - prefix := STRCONC(prefix,", [",xfstring,"],[",yfstring,"],") - prefix := STRCONC(prefix,STRINGIMAGE lyf,", [",ipstring,"]::Matrix Integer,") - prefix := STRCONC(prefix,STRINGIMAGE lwrk,", ",STRINGIMAGE liwrk,", ") - prefix := STRCONC(prefix,STRINGIMAGE ifail,")") - linkGen prefix - -e02ahf() == - htInitPage('"E02AHF - Derivative of fitted polynomial in Chebyshev series",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXe02ahf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02ahf| '|NagFittingPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "Determines the indefinite integral of the Chebyshev series ") - (text . "representation \newline \center{\htbitmap{e02ahf1}} ") - (text . "of a polynomial, where \htbitmap{xbar} is the ") - (text . "normalised argument, related to the original variable x by the ") - (text . "transformation \blankline \center{\htbitmap{e02adf1}}") - (text . ",\htbitmap{xmin} and \htbitmap{xmax} being ") - (text . "minimum and maximum values of {\it x} respectively. The integral") - (text . " polynomial has the form ") - (text . "\blankline \center{\htbitmap{e02ahf}}") - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} \newline ") - (text . "Degree of the polynomial {\it n}:") - (text . "\newline \tab{2} ") - (bcStrings (6 6 n PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "\newline \htbitmap{xmin}: ") - (text . "\tab{32} \menuitemstyle{}\tab{34}") - (text . "\htbitmap{xmax}: ") - (text . "\newline\tab{2} ") - (bcStrings (6 "-0.5" xmin F)) - (text . "\tab{34} ") - (bcStrings (6 "2.5" xmax F)) --- (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{}\tab{2}") --- (text . "\newline Dimension of array {\it a}, {\it la}: ") --- (text . "\tab{32} \menuitemstyle{}\tab{34}") --- (text . "Dimension of {\it adif}, {\it ladif}: ") --- (text . "\newline\tab{2} ") --- (bcStrings (6 7 la PI)) --- (text . "\tab{34} ") --- (bcStrings (6 7 ladif PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "\newline Increment of array {\it a}, {\it ia1}: ") - (text . "\tab{32} \menuitemstyle{}\tab{34}") - (text . "\newline Increment of array {\it adif}, {\it ladif1}: ") - (text . "\newline\tab{2} ") - (bcStrings (6 1 iaone PI)) - (text . "\tab{34} ") - (bcStrings (6 1 ladifone PI)) - (text . "\blankline") - (text . "\newline \menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'e02ahfSolve) - htShowPage() - -e02ahfSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - xmin := htpLabelInputString(htPage,'xmin) - xmax := htpLabelInputString(htPage,'xmax) - iaone := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iaone) - objValUnwrap htpLabelSpadValue(htPage, 'iaone) - ladifone := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ladifone) - objValUnwrap htpLabelSpadValue(htPage, 'ladifone) - la := 1+n*iaone --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'la) --- objValUnwrap htpLabelSpadValue(htPage, 'la) - ladif :=1+n*ladifone --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ladif) --- objValUnwrap htpLabelSpadValue(htPage, 'ladif) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - (n = '6 and (la ='7 and ladif = '7)) => - e02ahfDefaultSolve(htPage,xmin,xmax,iaone,ladifone,ifail) - labelList := - "append"/[f(i) for i in 1..la] where f(i) == - prefix := ('"\newline \tab{15} ") - anam := INTERN STRCONC ('"a",STRINGIMAGE i) - [['text,:prefix],['bcStrings,[10, "0.0000", anam, 'F]]] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :labelList] - page := htInitPage("E02AHF - Derivative of fitted polynomial in Chebyshev series",nil) - htSay '"\menuitemstyle{}\tab{2} Coefficients of {\it a(la)}:" - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'e02ahfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'la,la) - htpSetProperty(page,'ladif,ladif) - htpSetProperty(page,'xmin,xmin) - htpSetProperty(page,'xmax,xmax) - htpSetProperty(page,'iaone,iaone) - htpSetProperty(page,'ladifone,ladifone) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -e02ahfDefaultSolve (htPage,xmin,xmax,iaone,ladifone,ifail) == - n := '6 - la := '7 - ladif := '7 - page := htInitPage('"E02AHF - Derivative of fitted polynomial in Chebyshev series",nil) - htMakePage '( - (domainConditions - (isDomain PI (Positive Integer)) - (isDomain F (Float))) - (text . "\menuitemstyle{}\tab{2} ") - (text . "Coefficients of {\it a(la)}: ") - (text . "\newline \tab{15}") - (bcStrings (10 "2.53213" a1 F)) - (text . "\newline \tab{15}") - (bcStrings (10 "1.13032" a2 F)) - (text . "\newline \tab{15}") - (bcStrings (10 "0.27150" a3 F)) - (text . "\newline \tab{15}") - (bcStrings (10 "0.04434" a4 F)) - (text . "\newline \tab{15}") - (bcStrings (10 "0.00547" a5 F)) - (text . "\newline \tab{15}") - (bcStrings (10 "0.00054" a6 F)) - (text . "\newline \tab{15}") - (bcStrings (10 "0.00004" a7 F)) - (text . "\blankline")) - htMakeDoneButton('"Continue",'e02ahfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'la,la) - htpSetProperty(page,'ladif,ladif) - htpSetProperty(page,'xmin,xmin) - htpSetProperty(page,'xmax,xmax) - htpSetProperty(page,'iaone,iaone) - htpSetProperty(page,'ladifone,ladifone) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -e02ahfGen htPage == - n := htpProperty(htPage,'n) - la := htpProperty(htPage,'la) - ladif := htpProperty(htPage,'ladif) - xmin := htpProperty(htPage,'xmin) - xmax := htpProperty(htPage,'xmax) - iaone := htpProperty(htPage,'iaone) - ladifone := htpProperty(htPage,'ladifone) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - np1 := n + 1 - y := alist - while y repeat - right := STRCONC ((first y).1," ") - y := rest y - arrayList := [right,:arrayList] - astring := bcwords2liststring arrayList - prefix := STRCONC('"e02ahf(",STRINGIMAGE np1,", ",xmin,", ",xmax,", [") - prefix := STRCONC(prefix,astring,"], ",STRINGIMAGE iaone,", ") - prefix := STRCONC(prefix,STRINGIMAGE la,", ",STRINGIMAGE ladifone,", ") - prefix := STRCONC(prefix,STRINGIMAGE ladif,", ",STRINGIMAGE ifail,")") - linkGen prefix - -e02ajf() == - htInitPage('"E02AJF - Integral of fitted polynomial in Chebyshev series form",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXe02ajf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02ajf| '|NagFittingPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "Determines the indefinite integral of the Chebyshev series ") - (text . "representation \newline \center{\htbitmap{e02ahf1}} ") - (text . "of a polynomial, where \htbitmap{xbar} is the normalis") - (text . "ed argument, related to the original variable {\it x} by the ") - (text . "transformation \blankline \center{\htbitmap{e02adf1}}") - (text . ",\htbitmap{xmin} and \htbitmap{xmax} being ") - (text . "minimum and maximum values of {\it x} respectively. The integral") - (text . " polynomial has the form ") - (text . "\blankline \center{\htbitmap{e02ajf}}") - (text . "and the integration is with respect to the original variable ") - (text . "{\it x} \blankline ") - (text . "\newline \menuitemstyle{}\tab{2} \newline ") - (text . "Degree of the polynomial {\it n}:") - (text . "\newline \tab{2} ") - (bcStrings (6 6 n PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "\newline \htbitmap{xmin}: ") - (text . "\tab{32} \menuitemstyle{}\tab{34}") - (text . "\htbitmap{xmax}: ") - (text . "\newline\tab{2} ") - (bcStrings (6 "-0.5" xmin F)) - (text . "\tab{34} ") - (bcStrings (6 "2.5" xmax F)) --- (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{}\tab{2}") --- (text . "\newline Dimension of array {\it a}, {\it la}: ") --- (text . "\tab{32} \menuitemstyle{}\tab{34}") --- (text . "Dimension of {\it aint}, {\it laint}: ") --- (text . "\newline\tab{2} ") --- (bcStrings (6 7 la PI)) --- (text . "\tab{34} ") --- (bcStrings (6 8 laint PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "\newline Index increment of {\it a}, {\it ia1}: ") - (text . "\tab{32} \menuitemstyle{}\tab{34}") - (text . "Increment of {\it aint}, {\it iaint1}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 1 iaone PI)) - (text . "\tab{34} ") - (bcStrings (6 1 iaintone PI)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} \newline ") - (text . "Constant of integration {\it qatm1}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" qatmone F)) - (text . "\blankline") - (text . "\newline \menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'e02ajfSolve) - htShowPage() - -e02ajfSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - xmin := htpLabelInputString(htPage,'xmin) - xmax := htpLabelInputString(htPage,'xmax) - iaone := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iaone) - objValUnwrap htpLabelSpadValue(htPage, 'iaone) - iaintone := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iaintone) - objValUnwrap htpLabelSpadValue(htPage, 'iaintone) - la := 1+n*iaone --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'la) --- objValUnwrap htpLabelSpadValue(htPage, 'la) - laint := n*iaintone + 1 - qatmone := htpLabelInputString(htPage,'qatmone) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - (n = '6 and (la ='7 and laint = '7)) => - e02ajfDefaultSolve(htPage,xmin,xmax,iaone,iaintone,qatmone,ifail) - labelList := - "append"/[f(i) for i in 1..la] where f(i) == - prefix := ('"\newline \tab{15} ") - anam := INTERN STRCONC ('"a",STRINGIMAGE i) - [['text,:prefix],['bcStrings,[10, "0.0000", anam, 'F]]] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :labelList] - page := htInitPage("E02AJF - Integral of fitted polynomial in Chebyshev series form",nil) - htSay '"\menuitemstyle{}\tab{2} Coefficients of {\it a(la)}: " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'e02ajfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'la,la) - htpSetProperty(page,'laint,laint) - htpSetProperty(page,'xmin,xmin) - htpSetProperty(page,'xmax,xmax) - htpSetProperty(page,'iaone,iaone) - htpSetProperty(page,'iaintone,iaintone) - htpSetProperty(page,'qatmone,qatmone) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -e02ajfDefaultSolve (htPage,xmin,xmax,iaone,iaintone,qatmone,ifail) == - n := '6 - la := '7 - laint := '8 - page := htInitPage('"E02AJF - Integral of fitted polynomial in Chebyshev series form",nil) - htMakePage '( - (domainConditions - (isDomain PI (Positive Integer)) - (isDomain F (Float))) - (text . "\menuitemstyle{}\tab{2} ") - (text . "Coefficients of {\it a(la)}: ") - (text . "\newline \tab{15}") - (bcStrings (10 "2.53213" a1 F)) - (text . "\newline \tab{15}") - (bcStrings (10 "1.13032" a2 F)) - (text . "\newline \tab{15}") - (bcStrings (10 "0.27150" a3 F)) - (text . "\newline \tab{15}") - (bcStrings (10 "0.04434" a4 F)) - (text . "\newline \tab{15}") - (bcStrings (10 "0.00547" a5 F)) - (text . "\newline \tab{15}") - (bcStrings (10 "0.00054" a6 F)) - (text . "\newline \tab{15}") - (bcStrings (10 "0.00004" a7 F)) - (text . "\blankline")) - htMakeDoneButton('"Continue",'e02ajfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'la,la) - htpSetProperty(page,'laint,laint) - htpSetProperty(page,'xmin,xmin) - htpSetProperty(page,'xmax,xmax) - htpSetProperty(page,'iaone,iaone) - htpSetProperty(page,'iaintone,iaintone) - htpSetProperty(page,'qatmone,qatmone) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -e02ajfGen htPage == - n := htpProperty(htPage,'n) - la := htpProperty(htPage,'la) - laint := htpProperty(htPage,'laint) - xmin := htpProperty(htPage,'xmin) - xmax := htpProperty(htPage,'xmax) - iaone := htpProperty(htPage,'iaone) - iaintone := htpProperty(htPage,'iaintone) - qatmone := htpProperty(htPage,'qatmone) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - np1 := n + 1 - y := alist - while y repeat - right := STRCONC ((first y).1," ") - y := rest y - arrayList := [right,:arrayList] - astring := bcwords2liststring arrayList - prefix := STRCONC('"e02ajf(",STRINGIMAGE np1,", ",xmin,", ",xmax,", [") - prefix := STRCONC(prefix,astring,"], ",STRINGIMAGE iaone,", ") - prefix := STRCONC(prefix,STRINGIMAGE la,", ",qatmone,", ") - prefix := STRCONC(prefix,STRINGIMAGE iaintone) - prefix := STRCONC(prefix,", ",STRINGIMAGE laint,", ",STRINGIMAGE ifail,")") - linkGen prefix - -e02akf() == - htInitPage('"E02AKF - Evaluation of fitted polynomial in one variable, from Chebyshev series form",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXe02akf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02akf| '|NagFittingPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "Evaluates at the point x the Chebyshev series representation ") - (text . "representation \newline \center{\htbitmap{e02ahf1}} ") - (text . "of a polynomial, where \htbitmap{xbar} is the normalis") - (text . "ed argument, related to the original variable {\it x} by the ") - (text . "transformation \blankline \center{\htbitmap{e02adf1}}") - (text . ",\htbitmap{xmin} and \htbitmap{xmax} being ") - (text . "minimum and maximum values of {\it x} respectively. ") - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} \newline ") - (text . "Degree of the polynomial {\it n}:") - (text . "\tab{32} \menuitemstyle{}\tab{34}") - (text . "Evaluation point {\it x}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 6 n PI)) - (text . "\tab{34} ") - (bcStrings (6 "-0.5" x F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "\newline \htbitmap{xmin}: ") - (text . "\tab{32} \menuitemstyle{}\tab{34}") - (text . "\htbitmap{xmax}: ") - (text . "\newline\tab{2} ") - (bcStrings (6 "-0.5" xmin F)) - (text . "\tab{34} ") - (bcStrings (6 "2.5" xmax F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") --- (text . "\newline Dimension of array {\it a}, {\it la} : ") --- (text . "\tab{32} \menuitemstyle{}\tab{34}") - (text . "Index increment of {\it a}, {\it ia1}: ") - (text . "\newline\tab{2} ") --- (bcStrings (6 7 la PI)) --- (text . "\tab{34} ") - (bcStrings (6 1 iaone PI)) - (text . "\blankline") - (text . "\newline \menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'e02akfSolve) - htShowPage() - -e02akfSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - x := htpLabelInputString(htPage,'x) - xmin := htpLabelInputString(htPage,'xmin) - xmax := htpLabelInputString(htPage,'xmax) - iaone := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iaone) - objValUnwrap htpLabelSpadValue(htPage, 'iaone) - la := 1+n*iaone --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'la) --- objValUnwrap htpLabelSpadValue(htPage, 'la) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - (n = '6 and la ='7) => e02akfDefaultSolve(htPage,xmin,xmax,x,iaone,ifail) - labelList := - "append"/[f(i) for i in 1..la] where f(i) == - prefix := ('"\newline \tab{15} ") - anam := INTERN STRCONC ('"a",STRINGIMAGE i) - [['text,:prefix],['bcStrings,[10, "0.0000", anam, 'F]]] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :labelList] - page := htInitPage("E02AKF - Evaluation of fitted polynomial in one variable, from Chebyshev series form",nil) - htSay '"\menuitemstyle{}\tab{2} Coefficients of {\it a(la)}:" - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'e02akfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'x,x) - htpSetProperty(page,'la,la) - htpSetProperty(page,'xmin,xmin) - htpSetProperty(page,'xmax,xmax) - htpSetProperty(page,'iaone,iaone) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -e02akfDefaultSolve (htPage,xmin,xmax,x,iaone,ifail) == - n := '6 - la := '7 - page := htInitPage('"E02AKF - Evaluation of fitted polynomial in one variable, from Chebyshev series form",nil) - htMakePage '( - (domainConditions - (isDomain PI (Positive Integer)) - (isDomain F (Float))) - (text . "\menuitemstyle{}\tab{2} ") - (text . "Coefficients of {\it a(la)}: ") - (text . "\newline \tab{15}") - (bcStrings (10 "2.53213" a1 F)) - (text . "\newline \tab{15}") - (bcStrings (10 "1.13032" a2 F)) - (text . "\newline \tab{15}") - (bcStrings (10 "0.27150" a3 F)) - (text . "\newline \tab{15}") - (bcStrings (10 "0.04434" a4 F)) - (text . "\newline \tab{15}") - (bcStrings (10 "0.00547" a5 F)) - (text . "\newline \tab{15}") - (bcStrings (10 "0.00054" a6 F)) - (text . "\newline \tab{15}") - (bcStrings (10 "0.00004" a7 F)) - (text . "\blankline")) - htMakeDoneButton('"Continue",'e02akfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'la,la) - htpSetProperty(page,'x,x) - htpSetProperty(page,'xmin,xmin) - htpSetProperty(page,'xmax,xmax) - htpSetProperty(page,'iaone,iaone) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -e02akfGen htPage == - n := htpProperty(htPage,'n) - x := htpProperty(htPage,'x) - la := htpProperty(htPage,'la) - xmin := htpProperty(htPage,'xmin) - xmax := htpProperty(htPage,'xmax) - iaone := htpProperty(htPage,'iaone) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - np1 := n + 1 - y := alist - while y repeat - right := STRCONC ((first y).1," ") - y := rest y - arrayList := [right,:arrayList] - astring := bcwords2liststring arrayList - prefix := STRCONC('"e02akf(",STRINGIMAGE np1,", ",xmin,", ",xmax,", [") - prefix := STRCONC(prefix,astring,"], ",STRINGIMAGE iaone,", ") - prefix := STRCONC(prefix,STRINGIMAGE la,", ",x,", ",STRINGIMAGE ifail,")") - linkGen prefix - - -e02baf() == - htInitPage('"E02BAF - Least-squares curve cubic spine fit",nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXe02baf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02baf| '|NagFittingPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "Determines a least-squares cubic spline approximation to the ") - (text . "set of points {\it (}\htbitmap{xr},") - (text . "\htbitmap{yr}{\it )} with weights ") - (text . "\htbitmap{wr}, for r = 1,2,...,m. ") - (text . "The knots \htbitmap{lamdai}, for i = 1,2,...,") - (text . "\htbitmap{ncap}+7, are prescribed by the user. The ") - (text . "spline is given by the B-spline representation \blankline ") - (text . "\center{\htbitmap{e02baf}} where ") - (text . "\htbitmap{ncap} is the number of intervals of the ") - (text . "spline. \blankline ") - (text . "\newline \menuitemstyle{}\tab{2} \newline ") - (text . "Number of data points {\it m}:") - (text . "\newline \tab{2} ") - (bcStrings (6 14 m PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Number of intervals in the spline \htbitmap{ncap}: ") - (text . "\newline\tab{2} ") - (bcStrings (6 5 ncap PI)) - (text . "\blankline") - (text . "\newline") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'e02bafSolve) - htShowPage() - -e02bafSolve htPage == - m := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) - objValUnwrap htpLabelSpadValue(htPage, 'm) - ncap := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ncap) - objValUnwrap htpLabelSpadValue(htPage, 'ncap) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - (m = '14 and ncap ='5) => e02bafDefaultSolve(htPage,ifail) - labelList := - "append"/[f(i) for i in 1..m] where f(i) == - prefix := ('"\newline \tab{2} ") - middle := ('"\tab{22} ") - post := ('" \tab{42} ") - xnam := INTERN STRCONC ('"x",STRINGIMAGE i) - ynam := INTERN STRCONC ('"y",STRINGIMAGE i) - znam := INTERN STRCONC ('"z",STRINGIMAGE i) - num := INTERN STRCONC (STRINGIMAGE (QUOTIENT(i,10)),".",STRINGIMAGE (REM(i,10))) - [['text,:prefix],['bcStrings,[10, num, xnam, 'F]], - ['text,:middle],['bcStrings,[10, 0.0, ynam, 'F]], - ['text,:post],['bcStrings,[10, 0.0, znam, 'F]]] - lamdaList := - "append"/[g(j) for j in 5..(ncap+3)] where g(j) == - anam := INTERN STRCONC ('"a",STRINGIMAGE j) - [['bcStrings,[6, 0.0, anam, 'F]]] - prefix := ('"\blankline \menuitemstyle{}\tab{2} Interior knots ") - prefix := STRCONC(prefix,"\htbitmap{lamdai}, for i = 5,6,...,") - prefix := STRCONC(prefix,"\htbitmap{ncap} + 3: \newline \tab{2}" ) - lamdaList := [['text,:prefix],:lamdaList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :labelList,:lamdaList] - page := htInitPage("E02BAF - Least-squares curve cubic spline fit",nil) - htSay '"\menuitemstyle{}\tab{2} Values of \space{1} " - htSay '"\htbitmap{xr}: \tab{20} \menuitemstyle{}\tab{22} " - htSay '"Values of \space{1} \htbitmap{fr}: \tab{40}" - htSay '"\menuitemstyle{}\tab{42} Values of \space{1} " - htSay '"\htbitmap{dr}: " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'e02bafGen) - htpSetProperty(page,'m,m) - htpSetProperty(page,'ncap,ncap) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -e02bafDefaultSolve (htPage,ifail) == - m := '14 - ncap := '5 - page := htInitPage('"E02BAF - Least-squares curve cubic spline fit",nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\menuitemstyle{}\tab{2} Values of \space{1} ") - (text . "\htbitmap{xr}: \tab{20} \menuitemstyle{}\tab{22} ") - (text . "Values of \space{1} \htbitmap{yr}: \tab{40} ") - (text . "\menuitemstyle{}\tab{42} Values of \space{1} ") - (text . "\htbitmap{wr}: ") - (text . "\newline \tab{2}") - (bcStrings (10 "0.20" x1 F)) - (text . "\tab{22} ") - (bcStrings (10 "0.00" y1 F)) - (text . "\tab{42} ") - (bcStrings (10 "0.20" z1 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.47" x2 F)) - (text . "\tab{22} ") - (bcStrings (10 "2.00" y2 F)) - (text . "\tab{42} ") - (bcStrings (10 "0.20" z2 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.74" x3 F)) - (text . "\tab{22} ") - (bcStrings (10 "4.00" y3 F)) - (text . "\tab{42} ") - (bcStrings (10 "0.30" z3 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "1.09" x4 F)) - (text . "\tab{22} ") - (bcStrings (10 "6.00" y4 F)) - (text . "\tab{42} ") - (bcStrings (10 "0.70" z4 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "1.60" x5 F)) - (text . "\tab{22} ") - (bcStrings (10 "8.00" y5 F)) - (text . "\tab{42} ") - (bcStrings (10 "0.90" z5 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "1.90" x6 F)) - (text . "\tab{22} ") - (bcStrings (10 "8.62" y6 F)) - (text . "\tab{42} ") - (bcStrings (10 "1.00" z6 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "2.60" x7 F)) - (text . "\tab{22} ") - (bcStrings (10 "9.10" y7 F)) - (text . "\tab{42} ") - (bcStrings (10 "1.00" z7 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "3.10" x8 F)) - (text . "\tab{22} ") - (bcStrings (10 "8.90" y8 F)) - (text . "\tab{42} ") - (bcStrings (10 "1.00" z8 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "4.00" x9 F)) - (text . "\tab{22} ") - (bcStrings (10 "8.15" y9 F)) - (text . "\tab{42} ") - (bcStrings (10 "0.80" z9 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "5.15" x10 F)) - (text . "\tab{22} ") - (bcStrings (10 "7.00" y10 F)) - (text . "\tab{42} ") - (bcStrings (10 "0.50" z10 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "6.17" x11 F)) - (text . "\tab{22} ") - (bcStrings (10 "6.00" y11 F)) - (text . "\tab{42} ") - (bcStrings (10 "0.70" z11 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "8.00" x12 F)) - (text . "\tab{22} ") - (bcStrings (10 "4.54" y12 F)) - (text . "\tab{42} ") - (bcStrings (10 "1.00" z12 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "10.00" x13 F)) - (text . "\tab{22} ") - (bcStrings (10 "3.39" y13 F)) - (text . "\tab{42} ") - (bcStrings (10 "1.00" z13 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "12.00" x14 F)) - (text . "\tab{22} ") - (bcStrings (10 "2.56" y14 F)) - (text . "\tab{42} ") - (bcStrings (10 "1.00" z14 F)) - (text . "\blankline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "Interior knots \htbitmap{lamdai}, for i = 5,6,...") - (text . "\htbitmap{ncap} + 3: \newline \tab{2}") - (bcStrings (6 "1.50" l1 F)) - (bcStrings (6 "2.60" l2 F)) - (bcStrings (6 "4.00" l3 F)) - (bcStrings (6 "8.00" l4 F)) - (text . "\blankline")) - htMakeDoneButton('"Continue",'e02bafGen) - htpSetProperty(page,'m,m) - htpSetProperty(page,'ncap,ncap) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -e02bafGen htPage == - m := htpProperty(htPage,'m) - ncap := htpProperty(htPage,'ncap) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - ncap7 := ncap + 7 - y := alist - for i in (ncap+4)..(ncap+7) repeat - lambda := STRCONC( "0.0"," ") - lambdaList := [lambda,:lambdaList] - for i in 5..(ncap+3) repeat - lambda := STRCONC ((first y).1," ") - y := rest y - lambdaList := [lambda,:lambdaList] - for i in 1..4 repeat - lambda := STRCONC( "0.0"," ") - lambdaList := [lambda,:lambdaList] - lambdaString := bcwords2liststring lambdaList - while y repeat - right := STRCONC ((first y).1," ") - y := rest y - mid := STRCONC ((first y).1," ") - y := rest y - left := STRCONC ((first y).1," ") - y := rest y - xlist := [left,:xlist] - ylist := [mid,:ylist] - wlist := [right,:wlist] - xstring := bcwords2liststring xlist - ystring := bcwords2liststring ylist - wstring := bcwords2liststring wlist - prefix := STRCONC('"e02baf(",STRINGIMAGE m,", ",STRINGIMAGE ncap7,", [") - prefix := STRCONC(prefix,xstring,"],[",ystring,"],[",wstring,"], [") - prefix := STRCONC(prefix,lambdaString,"], ",STRINGIMAGE ifail,")") - linkGen prefix - - -e02bbf() == - htInitPage('"E02BBF - Evaluation of fitted cubic spline, function only",nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXe02bbf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02bbf| '|NagFittingPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "Evaluates at the point {\it x} a cubic spline from its B-spline ") - (text . "B-spline representation ") - (text . "\center{\htbitmap{e02baf}} where ") - (text . "\htbitmap{ncap} is the number of intervals of the ") - (text . "spline. The spline has knots \htbitmap{lamdai}, for ") - (text . "i = 1,2,...,\htbitmap{ncap} + 7. \blankline ") - (text . "\newline \menuitemstyle{}\tab{2} \newline ") - (text . "Number of intervals in the spline \htbitmap{ncap}: ") - (text . "\newline\tab{2} ") - (bcStrings (6 4 ncap PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Evaluation point {\it x}:") - (text . "\newline \tab{2} ") - (bcStrings (6 "2.0" x F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'e02bbfSolve) - htShowPage() - -e02bbfSolve htPage == - ncap := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ncap) - objValUnwrap htpLabelSpadValue(htPage, 'ncap) - x := htpLabelInputString(htPage,'x) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - ncap = '4 => e02bbfDefaultSolve(htPage,x,ifail) - labelList := - "append"/[f(i) for i in 1..(ncap+7)] where f(i) == - prefix := ('"\newline \tab{2} ") - middle := ('"\tab{22} ") - lnam := INTERN STRCONC ('"l",STRINGIMAGE i) - cnam := INTERN STRCONC ('"c",STRINGIMAGE i) - num := INTERN STRCONC (STRINGIMAGE (QUOTIENT(i,10)),".",STRINGIMAGE (REM(i,10))) - [['text,:prefix],['bcStrings,[10, num, lnam, 'F]], - ['text,:middle],['bcStrings,[10, 0.0, cnam, 'F]]] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :labelList] - page := htInitPage("E02BBF - Evaluation of fitted cubic spline, function only",nil) - htSay '"\menuitemstyle{}\tab{2} Knots \htbitmap{lamdai}: " - htSay '"\tab{20} \menuitemstyle{}\tab{22} " - htSay '"Coefficients \space{1} \htbitmap{ci}: " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'e02bbfGen) - htpSetProperty(page,'ncap,ncap) - htpSetProperty(page,'x,x) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -e02bbfDefaultSolve (htPage,x,ifail) == - ncap := '4 - page := htInitPage('"E02BBF - Evaluation of fitted cubic spline, function only",nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Knots \space{1}") - (text . "\htbitmap{lamdai}: \tab{20} \menuitemstyle{}\tab{22} ") - (text . "Coefficients \space{1} \htbitmap{ci}: ") - (text . "\newline \tab{2}") - (bcStrings (10 "1.00" l1 F)) - (text . "\tab{22} ") - (bcStrings (10 "1.00" c1 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "1.00" l2 F)) - (text . "\tab{22} ") - (bcStrings (10 "2.00" c2 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "1.00" l3 F)) - (text . "\tab{22} ") - (bcStrings (10 "4.00" c3 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "1.00" l4 F)) - (text . "\tab{22} ") - (bcStrings (10 "7.00" c4 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "3.00" l5 F)) - (text . "\tab{22} ") - (bcStrings (10 "6.00" c5 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "6.00" l6 F)) - (text . "\tab{22} ") - (bcStrings (10 "4.00" c6 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "8.00" l7 F)) - (text . "\tab{22} ") - (bcStrings (10 "3.00" c7 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "9.00" l8 F)) - (text . "\tab{22} ") - (bcStrings (10 "0.00" c8 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "9.00" l9 F)) - (text . "\tab{22} ") - (bcStrings (10 "0.00" c9 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "9.00" l10 F)) - (text . "\tab{22} ") - (bcStrings (10 "0.00" c10 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "9.00" l11 F)) - (text . "\tab{22} ") - (bcStrings (10 "0.00" c11 F)) - (text . "\blankline")) - htMakeDoneButton('"Continue",'e02bbfGen) - htpSetProperty(page,'ncap,ncap) - htpSetProperty(page,'x,x) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -e02bbfGen htPage == - ncap := htpProperty(htPage,'ncap) - x := htpProperty(htPage,'x) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - ncap7 := ncap + 7 - y := alist - while y repeat - right := STRCONC ((first y).1," ") - y := rest y - left := STRCONC ((first y).1," ") - y := rest y - lamlist := [left,:lamlist] - clist := [right,:clist] - lamstring := bcwords2liststring lamlist - cstring := bcwords2liststring clist - prefix := STRCONC('"e02bbf(",STRINGIMAGE ncap7,", [",lamstring,"],[") - prefix := STRCONC(prefix,cstring,"], ",x,", ",STRINGIMAGE ifail,")") - linkGen prefix - - -e02bcf() == - htInitPage('"E02BCF - Evaluation of fitted cubic spline, function and derivatives",nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXe02bcf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02bcf| '|NagFittingPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "Evaluates at the point {\it x} a cubic spline and its first ") - (text . "three derivatives from its B-spline representation ") - (text . "\center{\htbitmap{e02baf}} where ") - (text . "\htbitmap{ncap} is the number of intervals of the ") - (text . "spline. The spline has knots \htbitmap{lamdai}, for ") - (text . "i = 1,2,...,\htbitmap{ncap} + 7. \blankline ") - (text . "\newline \menuitemstyle{}\tab{2} \newline ") - (text . "Number of intervals in the spline \htbitmap{ncap}: ") - (text . "\newline\tab{2} ") - (bcStrings (6 7 ncap PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Evaluation point {\it x}:") - (text . "\newline \tab{2} ") - (bcStrings (6 "2.0" x F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "{\it LEFT} specifies whether LH or RH derivatives are required: ") - (radioButtons deriv - ("" " Left-hand derivative" left) - ("" " Right-hand derivative" right)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'e02bcfSolve) - htShowPage() - -e02bcfSolve htPage == - ncap := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ncap) - objValUnwrap htpLabelSpadValue(htPage, 'ncap) - x := htpLabelInputString(htPage,'x) - temp := htpButtonValue(htPage,'deriv) - deriv := - temp = 'left => '1 - '2 - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - ncap = '7 => e02bcfDefaultSolve(htPage,x,deriv,ifail) - labelList := - "append"/[f(i) for i in 1..(ncap+7)] where f(i) == - prefix := ('"\newline \tab{2} ") - middle := ('"\tab{22} ") - lnam := INTERN STRCONC ('"l",STRINGIMAGE i) - cnam := INTERN STRCONC ('"c",STRINGIMAGE i) - num := INTERN STRCONC (STRINGIMAGE (QUOTIENT(i,10)),".",STRINGIMAGE (REM(i,10))) - [['text,:prefix],['bcStrings,[10, num, lnam, 'F]], - ['text,:middle],['bcStrings,[10, 0.0, cnam, 'F]]] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :labelList] - page := htInitPage("E02BCF - Evaluation of fitted cubic spline, function and derivatives",nil) - htSay '"\menuitemstyle{}\tab{2} Knots \htbitmap{lamdai}: " - htSay '"\tab{20} \menuitemstyle{}\tab{22} " - htSay '"Coefficients \space{1} \htbitmap{ci}: " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'e02bcfGen) - htpSetProperty(page,'ncap,ncap) - htpSetProperty(page,'x,x) - htpSetProperty(page,'deriv,deriv) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -e02bcfDefaultSolve (htPage,x,deriv,ifail) == - ncap := '7 - page := htInitPage('"E02BCF - Evaluation of fitted cubic spline, function and derivatives",nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\menuitemstyle{}\tab{2} Knots \space{1}") - (text . "\htbitmap{lamdai}: \tab{20} \menuitemstyle{}\tab{22} ") - (text . "Coefficients \space{1} \htbitmap{ci}: ") - (text . "\newline \tab{2}") - (bcStrings (10 "0.0" l1 F)) - (text . "\tab{22} ") - (bcStrings (10 "10.00" c1 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.00" l2 F)) - (text . "\tab{22} ") - (bcStrings (10 "12.00" c2 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.00" l3 F)) - (text . "\tab{22} ") - (bcStrings (10 "13.00" c3 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.00" l4 F)) - (text . "\tab{22} ") - (bcStrings (10 "15.00" c4 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "1.00" l5 F)) - (text . "\tab{22} ") - (bcStrings (10 "22.00" c5 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "3.00" l6 F)) - (text . "\tab{22} ") - (bcStrings (10 "26.00" c6 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "3.00" l7 F)) - (text . "\tab{22} ") - (bcStrings (10 "24.00" c7 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "3.00" l8 F)) - (text . "\tab{22} ") - (bcStrings (10 "18.00" c8 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "4.00" l9 F)) - (text . "\tab{22} ") - (bcStrings (10 "14.00" c9 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "4.00" l10 F)) - (text . "\tab{22} ") - (bcStrings (10 "12.00" c10 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "6.00" l11 F)) - (text . "\tab{22} ") - (bcStrings (10 "0.00" c11 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "6.00" l12 F)) - (text . "\tab{22} ") - (bcStrings (10 "0.00" c12 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "6.00" l13 F)) - (text . "\tab{22} ") - (bcStrings (10 "0.00" c13 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "6.00" l14 F)) - (text . "\tab{22} ") - (bcStrings (10 "0.00" c14 F)) - (text . "\blankline")) - htMakeDoneButton('"Continue",'e02bcfGen) - htpSetProperty(page,'ncap,ncap) - htpSetProperty(page,'x,x) - htpSetProperty(page,'deriv,deriv) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -e02bcfGen htPage == - ncap := htpProperty(htPage,'ncap) - x := htpProperty(htPage,'x) - deriv := htpProperty(htPage,'deriv) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - ncap7 := ncap + 7 - y := alist - while y repeat - right := STRCONC ((first y).1," ") - y := rest y - left := STRCONC ((first y).1," ") - y := rest y - lamlist := [left,:lamlist] - clist := [right,:clist] - lamstring := bcwords2liststring lamlist - cstring := bcwords2liststring clist - prefix := STRCONC('"e02bcf(",STRINGIMAGE ncap7,", [",lamstring,"],[") - prefix := STRCONC(prefix,cstring,"], ",x,", ",STRINGIMAGE deriv) - prefix := STRCONC(prefix,", ",STRINGIMAGE ifail,")") - linkGen prefix - - - -e02bdf() == - htInitPage('"E02BDF - Evaluation of fitted cubic spline, definite integral",nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXe02bdf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02bdf| '|NagFittingPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "Evaluates the definite integral of a cubic spline from its ") - (text . "B-spline representation \center{\htbitmap{e02baf}} ") - (text . "where \htbitmap{ncap} is the number of intervals of ") - (text . "the spline. The spline has knots \htbitmap{lamdai}, ") - (text . "for i = 1,2,...,\htbitmap{ncap} + 7, and the integral ") - (text . "is evaluated over the range \htbitmap{e02bdf} ") - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} \newline ") - (text . "Number of intervals in the spline \htbitmap{ncap}: ") - (text . "\newline\tab{2} ") - (bcStrings (6 7 ncap PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'e02bdfSolve) - htShowPage() - -e02bdfSolve htPage == - ncap := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ncap) - objValUnwrap htpLabelSpadValue(htPage, 'ncap) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - ncap = '7 => e02bdfDefaultSolve(htPage,ifail) - labelList := - "append"/[f(i) for i in 1..(ncap+7)] where f(i) == - prefix := ('"\newline \tab{2} ") - middle := ('"\tab{22} ") - lnam := INTERN STRCONC ('"l",STRINGIMAGE i) - cnam := INTERN STRCONC ('"c",STRINGIMAGE i) - num := INTERN STRCONC (STRINGIMAGE (QUOTIENT(i,10)),".",STRINGIMAGE (REM(i,10))) - [['text,:prefix],['bcStrings,[10, num, lnam, 'F]], - ['text,:middle],['bcStrings,[10, 0.0, cnam, 'F]]] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :labelList] - page := htInitPage("E02BDF - Evaluation of fitted cubic spline, definite integral",nil) - htSay '"\menuitemstyle{}\tab{2} Knots \htbitmap{lamdai}: " - htSay '"\tab{20} \menuitemstyle{}\tab{22} " - htSay '"Coefficients \space{1} \htbitmap{ci}: " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'e02bdfGen) - htpSetProperty(page,'ncap,ncap) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -e02bdfDefaultSolve(htPage,ifail) == - ncap := '7 - page := htInitPage('"E02BDF - Evaluation of fitted cubic spline, definite integral",nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Knots \space{1}") - (text . "\htbitmap{lamdai}: \tab{20} \menuitemstyle{}\tab{22} ") - (text . "Coefficients \space{1} \htbitmap{ci}: ") - (text . "\newline \tab{2}") - (bcStrings (10 "0.0" l1 F)) - (text . "\tab{22} ") - (bcStrings (10 "10.00" c1 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.00" l2 F)) - (text . "\tab{22} ") - (bcStrings (10 "12.00" c2 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.00" l3 F)) - (text . "\tab{22} ") - (bcStrings (10 "13.00" c3 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.00" l4 F)) - (text . "\tab{22} ") - (bcStrings (10 "15.00" c4 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "1.00" l5 F)) - (text . "\tab{22} ") - (bcStrings (10 "22.00" c5 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "3.00" l6 F)) - (text . "\tab{22} ") - (bcStrings (10 "26.00" c6 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "3.00" l7 F)) - (text . "\tab{22} ") - (bcStrings (10 "24.00" c7 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "3.00" l8 F)) - (text . "\tab{22} ") - (bcStrings (10 "18.00" c8 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "4.00" l9 F)) - (text . "\tab{22} ") - (bcStrings (10 "14.00" c9 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "4.00" l10 F)) - (text . "\tab{22} ") - (bcStrings (10 "12.00" c10 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "6.00" l11 F)) - (text . "\tab{22} ") - (bcStrings (10 "0.00" c11 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "6.00" l12 F)) - (text . "\tab{22} ") - (bcStrings (10 "0.00" c12 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "6.00" l13 F)) - (text . "\tab{22} ") - (bcStrings (10 "0.00" c13 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "6.00" l14 F)) - (text . "\tab{22} ") - (bcStrings (10 "0.00" c14 F))) - htpSetProperty(page,'ncap,ncap) - htpSetProperty(page,'ifail,ifail) - htMakeDoneButton('"Continue",'e02bdfGen) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -e02bdfGen htPage == - ncap := htpProperty(htPage,'ncap) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - ncap7 := ncap + 7 - y := alist - while y repeat - right := STRCONC ((first y).1," ") - y := rest y - left := STRCONC ((first y).1," ") - y := rest y - lamlist := [left,:lamlist] - clist := [right,:clist] - lamstring := bcwords2liststring lamlist - cstring := bcwords2liststring clist - prefix := STRCONC('"e02bdf(",STRINGIMAGE ncap7,", [",lamstring,"],[") - prefix := STRCONC(prefix,cstring,"], ",STRINGIMAGE ifail,")") - linkGen prefix - - - -e02bef() == - htInitPage('"E02BEF - Least-squares curve cubic spline fit, automatic knot placement",nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXe02bef} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02bef| '|NagFittingPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "Determines a cubic spline approximation to the set of points ") - (text . "{\it ( \htbitmap{xr},\htbitmap{yr}) } ") - (text . "with weights \htbitmap{wr}, for r = 1,2,...,m. ") - (text . "The knots \htbitmap{lamdai}, for i = 1,2,...,n, ") - (text . "are chosen by the routine, but a single parameter S must be ") - (text . "specified to control the trade-off between closeness of fit and ") - (text . "smoothness of fit. This affects the number of knots required ") - (text . "by the spline, which is given in the B-spline representation ") - (text . "\center{\htbitmap{e02bef}}, where n-1 is the number of") - (text . " intervals of the spline. ") - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} \newline ") - (text . "Number of data points {\it m}: ") - (text . "\newline\tab{2} ") - (bcStrings (6 15 m PI)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} \newline ") - (text . "Smoothing factor {\it s}: ") - (text . "\newline\tab{2} ") - (bcStrings (6 "1.0" s F)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") - (text . "Over-estimate of number n of knots {\it nest}:\newline\tab{2} ") - (bcStrings (6 54 nest PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Start value: ") - (radioButtons start - ("" " Cold Start - no values needed for {\it n,lamda,wrk} or {\it iwrk}" cold) - ("" " Warm Start - uses knots found in a previous call" warm)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'e02befSolve) - htShowPage() - -e02befSolve htPage == - m := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) - objValUnwrap htpLabelSpadValue(htPage, 'm) - nest := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nest) - objValUnwrap htpLabelSpadValue(htPage, 'nest) - lwrk := 4*m +16*nest + 41 - s := htpLabelInputString(htPage,'s) - initial := htpButtonValue(htPage,'start) - start := - initial = 'cold => '1 - '2 - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - (m = 15 and start = 1) => e02befDefaultSolve (htPage,nest,lwrk,s,ifail) - start = 1 => e02befColdSolve (htPage,m,nest,lwrk,s,ifail) - -- warm start not really possible from hyperdoc - -- as inputing a workspace array of dimension 1105 is asking too much - -- user should use the command line, using the previous calculated - -- parameters - htInitPage('"E02BEF - Least-squares curve cubic spline fit, automatic knot placement",nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\blankline ") - (text . "{\center{\it Hyperdoc interface not available for warm starts.}}") - (text . "\newline ") - (text . "{\center{\it Please use the command line.}}")) - htMakeDoneButton('"Continue",'e02bef) - htShowPage() - - - -e02befColdSolve(htPage,m,nest,lwrk,s,ifail) == - labelList := - "append"/[f(i) for i in 1..m] where f(i) == - prefix := ('"\newline \tab{2} ") - middle := ('"\tab{22} ") - post := ('" \tab{42} ") - xnam := INTERN STRCONC ('"x",STRINGIMAGE i) - ynam := INTERN STRCONC ('"y",STRINGIMAGE i) - znam := INTERN STRCONC ('"z",STRINGIMAGE i) - num := INTERN STRCONC (STRINGIMAGE (QUOTIENT(i,10)),".",STRINGIMAGE (REM(i,10))) - [['text,:prefix],['bcStrings,[10, num, xnam, 'F]], - ['text,:middle],['bcStrings,[10, 0.0, ynam, 'F]], - ['text,:post],['bcStrings,[10, 0.0, znam, 'F]]] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :labelList] - page := htInitPage('"E02BEF - Least-squares curve cubic spline fit, automatic knot placement",nil) - htSay '"\menuitemstyle{}\tab{2} Values of \space{1} " - htSay '"\htbitmap{xr}: \tab{20} \menuitemstyle{}\tab{22} " - htSay '"Values of \space{1} \htbitmap{yr}: \tab{40}" - htSay '"\menuitemstyle{}\tab{42} Values of \space{1} " - htSay '"\htbitmap{wr}: " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'e02befColdGen) - htpSetProperty(page,'m,m) - htpSetProperty(page,'nest,nest) - htpSetProperty(page,'lwrk,lwrk) - htpSetProperty(page,'s,s) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -e02befDefaultSolve (htPage,nest,lwrk,s,ifail) == - m := 15 - page := htInitPage('"E02BEF - Least-squares curve cubic spline fit, automatic knot placement",nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Values of \space{1} ") - (text . "\htbitmap{xr}: \tab{20} \menuitemstyle{}\tab{22} ") - (text . "Values of \space{1} \htbitmap{yr}: \tab{40} ") - (text . "\menuitemstyle{}\tab{42} Values of \space{1} ") - (text . "\htbitmap{wr}: ") - (text . "\newline \tab{2}") - (bcStrings (10 "0.00" x1 F)) - (text . "\tab{22} ") - (bcStrings (10 "-1.1" y1 F)) - (text . "\tab{42} ") - (bcStrings (10 "1.00" z1 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "0.50" x2 F)) - (text . "\tab{22} ") - (bcStrings (10 "-0.372" y2 F)) - (text . "\tab{42} ") - (bcStrings (10 "2.00" z2 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "1.00" x3 F)) - (text . "\tab{22} ") - (bcStrings (10 "0.431" y3 F)) - (text . "\tab{42} ") - (bcStrings (10 "1.50" z3 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "1.50" x4 F)) - (text . "\tab{22} ") - (bcStrings (10 "1.69" y4 F)) - (text . "\tab{42} ") - (bcStrings (10 "1.00" z4 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "2.00" x5 F)) - (text . "\tab{22} ") - (bcStrings (10 "2.11" y5 F)) - (text . "\tab{42} ") - (bcStrings (10 "3.00" z5 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "2.50" x6 F)) - (text . "\tab{22} ") - (bcStrings (10 "3.10" y6 F)) - (text . "\tab{42} ") - (bcStrings (10 "1.00" z6 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "3.00" x7 F)) - (text . "\tab{22} ") - (bcStrings (10 "4.23" y7 F)) - (text . "\tab{42} ") - (bcStrings (10 "0.50" z7 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "4.00" x8 F)) - (text . "\tab{22} ") - (bcStrings (10 "4.35" y8 F)) - (text . "\tab{42} ") - (bcStrings (10 "1.00" z8 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "4.50" x9 F)) - (text . "\tab{22} ") - (bcStrings (10 "4.81" y9 F)) - (text . "\tab{42} ") - (bcStrings (10 "2.00" z9 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "5.00" x10 F)) - (text . "\tab{22} ") - (bcStrings (10 "4.61" y10 F)) - (text . "\tab{42} ") - (bcStrings (10 "2.50" z10 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "5.50" x11 F)) - (text . "\tab{22} ") - (bcStrings (10 "4.79" y11 F)) - (text . "\tab{42} ") - (bcStrings (10 "1.00" z11 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "6.00" x12 F)) - (text . "\tab{22} ") - (bcStrings (10 "5.23" y12 F)) - (text . "\tab{42} ") - (bcStrings (10 "3.00" z12 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "7.00" x13 F)) - (text . "\tab{22} ") - (bcStrings (10 "6.35" y13 F)) - (text . "\tab{42} ") - (bcStrings (10 "1.00" z13 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "7.50" x14 F)) - (text . "\tab{22} ") - (bcStrings (10 "7.19" y14 F)) - (text . "\tab{42} ") - (bcStrings (10 "2.00" z14 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "8.00" x15 F)) - (text . "\tab{22} ") - (bcStrings (10 "7.97" y15 F)) - (text . "\tab{42} ") - (bcStrings (10 "1.00" z15 F)) - (text . "\blankline")) - htMakeDoneButton('"Continue",'e02befColdGen) - htpSetProperty(page,'m,m) - htpSetProperty(page,'nest,nest) - htpSetProperty(page,'lwrk,lwrk) - htpSetProperty(page,'s,s) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -e02befColdGen htPage == - m := htpProperty(htPage,'m) - nest := htpProperty(htPage,'nest) - lwrk := htpProperty(htPage,'lwrk) - s := htpProperty(htPage,'s) - cold := '"c" - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - while y repeat - right := STRCONC ((first y).1," ") - y := rest y - mid := STRCONC ((first y).1," ") - y := rest y - left := STRCONC ((first y).1," ") - y := rest y - xlist := [left,:xlist] - ylist := [mid,:ylist] - wlist := [right,:wlist] - xstring := bcwords2liststring xlist - ystring := bcwords2liststring ylist - wstring := bcwords2liststring wlist - -- additional entries needed to get it running - -- but as Start = c they are not used - -- mmax := 50 - -- nest := mmax + 4 (54) - -- lwrk := 4*mmax + 16*nest+41 (1105) - prefix := STRCONC('"e02bef(_"",cold,"_",",STRINGIMAGE m,", [",xstring,"],[") - prefix := STRCONC(prefix,ystring,"],[",wstring,"], ",STRINGIMAGE s,", ") - prefix := STRCONC(prefix,STRINGIMAGE nest,", ",STRINGIMAGE lwrk) --- prefix := STRCONC(prefix,",0, [[0.0 for i in 1..",STRINGIMAGE nest,"]],") --- prefix := STRCONC(prefix,STRINGIMAGE ifail,", [[0.0 for i in 1..") --- prefix := STRCONC(prefix,STRINGIMAGE lwrk,"]], [[0 for i in 1..") --- prefix := STRCONC(prefix,STRINGIMAGE nest,"]] :: Matrix Integer)") - prefix := STRCONC(prefix,",0, new(1,",STRINGIMAGE nest,",0.0)$Matrix DoubleFloat,") - prefix := STRCONC(prefix,STRINGIMAGE ifail,", new(1,",STRINGIMAGE lwrk,",0.0)$Matrix DoubleFloat, ") - prefix := STRCONC(prefix," new(1,",STRINGIMAGE nest,",0)$Matrix Integer)") - linkGen prefix - -e02def() == - htInitPage('"E02DEF - Evaluation of a fitted bicubic spline at a vector of points",nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXe02def} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02def| '|NagFittingPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "Evaluates a bicubic spline at the (\htbitmap{xr},") - (text . "\htbitmap{yr}), for r = 1,2,...,m, from its B-spline ") - (text . "representation \htbitmap{e02daf} ") - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} \newline ") - (text . "Number of evaluation points, {\it m}: ") - (text . "\newline\tab{2} ") - (bcStrings (6 7 m PI)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} \newline ") - (text . "Number of (interior & exterior) knots ") - (text . "\lambda, \htbitmap{px} \htbitmap{great=} 8: \newline\tab{2} ") - (bcStrings (6 11 px PI)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} \newline ") - (text . "Number of (interior & exterior) knots ") - (text . "\mu, \htbitmap{py} \htbitmap{great=} 8: \newline\tab{2} ") - (bcStrings (6 10 py PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'e02defSolve) - htShowPage() - -e02defSolve htPage == - m := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) - objValUnwrap htpLabelSpadValue(htPage, 'm) - px := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'px) - objValUnwrap htpLabelSpadValue(htPage, 'px) - py := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'py) - objValUnwrap htpLabelSpadValue(htPage, 'py) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - ((m = '7 and px = '11) and py = '10) => e02defDefaultSolve(htPage,ifail) - labelList := - "append"/[fxy(i) for i in 1..m] where fxy(i) == - prefix := ('"\newline \tab{2} ") - middle := ('"\tab{22} ") - xnam := INTERN STRCONC ('"x",STRINGIMAGE i) - ynam := INTERN STRCONC ('"y",STRINGIMAGE i) - [['text,:prefix],['bcStrings,[8, 0.0, xnam, 'F]], - ['text,:middle],['bcStrings,[8, 0.0, ynam, 'F]]] - lamList := - "append"/[flam(i) for i in 1..px] where flam(i) == - lnam := INTERN STRCONC ('"l",STRINGIMAGE i) - [['bcStrings,[8, 0.0, lnam, 'F]]] - prefix := ('"\blankline \menuitemstyle{} \tab{2} {\it \lambda(nxest)}: \newline") - lamList := [['text,:prefix],:lamList] - muList := - "append"/[fmu(i) for i in 1..(py)] where fmu(i) == - mnam := INTERN STRCONC ('"m",STRINGIMAGE i) - [['bcStrings,[8, 0.0, mnam, 'F]]] - prefix := ('"\blankline \menuitemstyle{} \tab{2} {\it \mu(nyest)}:") - prefix := STRCONC(prefix,"\newline ") - muList := [['text,:prefix],:muList] - cList := - "append"/[fp(i) for i in 1..((px-4)*(py-4))] where fp(i) == - pnam := INTERN STRCONC ('"p",STRINGIMAGE i) - [['bcStrings,[8, 0.0, pnam, 'F]]] - prefix := ('"\blankline \menuitemstyle{}\tab{2}Enter values of ") - prefix := STRCONC(prefix,"{\it c((nxest*4)-(nyest*4))}: \newline ") - cList := [['text,:prefix],:cList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :labelList,:lamList,:muList,:cList] - page := htInitPage('"E02DEF - Evaluation of a fitted bicubic spline at a vector of points",nil) - htSay '"\menuitemstyle{}\tab{2} Values of \htbitmap{xr}: " - htSay '"\tab{20} \menuitemstyle{}\tab{22} Values of \htbitmap{yr}:" - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'e02defGen) - htpSetProperty(page,'m,m) - htpSetProperty(page,'px,px) - htpSetProperty(page,'py,py) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -e02defDefaultSolve (htPage,ifail) == - m := '7 - px := '11 - py := '10 - page := htInitPage('"E02DEF - Evaluation of a fitted bicubic spline at a vector of points",nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Values of \htbitmap{xr}:") - (text . "\tab{20} \menuitemstyle{} \tab{22} Values of ") - (text . "\htbitmap{yr}: ") - (text . "\newline \tab{2} ") - (bcStrings (8 "1" x1 F)) - (text . "\tab{22}") - (bcStrings (8 "0" y1 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "1.1" x2 F)) - (text . "\tab{22}") - (bcStrings (8 "0.1" y2 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "1.5" x3 F)) - (text . "\tab{22}") - (bcStrings (8 "0.7" y3 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "1.6" x4 F)) - (text . "\tab{22}") - (bcStrings (8 "0.4" y4 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "1.9" x5 F)) - (text . "\tab{22}") - (bcStrings (8 "0.3" y5 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "1.9" x6 F)) - (text . "\tab{22}") - (bcStrings (8 "0.8" y6 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "2" x7 F)) - (text . "\tab{22}") - (bcStrings (8 "1" y7 F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} {\it \lambda(nxest)}:") - (text . "\newline ") - (bcStrings (8 "1.0" l1 F)) - (bcStrings (8 "1.0" l2 F)) - (bcStrings (8 "1.0" l3 F)) - (bcStrings (8 "1.0" l4 F)) - (bcStrings (8 "1.3" l5 F)) - (bcStrings (8 "1.5" l6 F)) - (bcStrings (8 "1.6" l7 F)) - (bcStrings (8 "2" l8 F)) - (bcStrings (8 "2" l9 F)) - (bcStrings (8 "2" l10 F)) - (bcStrings (8 "2" l11 F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} {\it \mu(nyest)}:") - (text . "\newline ") - (bcStrings (8 "0" mu1 F)) - (bcStrings (8 "0" mu2 F)) - (bcStrings (8 "0" mu3 F)) - (bcStrings (8 "0" mu4 F)) - (bcStrings (8 "0.4" mu5 F)) - (bcStrings (8 "0.7" mu6 F)) - (bcStrings (8 "1" mu7 F)) - (bcStrings (8 "1" mu8 F)) - (bcStrings (8 "1" mu9 F)) - (bcStrings (8 "1" mu10 F)) - (text . "\blankline \menuitemstyle{}\tab{2} ") - (text . "Enter values for {\it c((nxest-4)*(nyest-4))}:") - (text . "\newline ") - (bcStrings (8 "1" c1 F)) - (bcStrings (8 "1.1333" c2 F)) - (bcStrings (8 "1.3667" c3 F)) - (bcStrings (8 "1.7" c4 F)) - (bcStrings (8 "1.9" c5 F)) - (bcStrings (8 "2" c6 F)) - (bcStrings (8 "1.2" c7 F)) - (bcStrings (8 "1.3333" c8 F)) - (bcStrings (8 "1.5667" c9 F)) - (bcStrings (8 "1.9" c10 F)) - (bcStrings (8 "2.1" c11 F)) - (bcStrings (8 "2.2" c12 F)) - (bcStrings (8 "1.5833" c13 F)) - (bcStrings (8 "1.7167" c14 F)) - (bcStrings (8 "1.95" c15 F)) - (bcStrings (8 "2.2833" c16 F)) - (bcStrings (8 "2.4833" c17 F)) - (bcStrings (8 "2.5833" c18 F)) - (bcStrings (8 "2.1433" c19 F)) - (bcStrings (8 "2.2767" c20 F)) - (bcStrings (8 "2.51" c21 F)) - (bcStrings (8 "2.8433" c22 F)) - (bcStrings (8 "3.0433" c23 F)) - (bcStrings (8 "3.1433" c24 F)) - (bcStrings (8 "2.8667" c25 F)) - (bcStrings (8 "3" c26 F)) - (bcStrings (8 "3.2333" c27 F)) - (bcStrings (8 "3.5667" c28 F)) - (bcStrings (8 "3.7667" c29 F)) - (bcStrings (8 "3.8667" c30 F)) - (bcStrings (8 "3.4667" c31 F)) - (bcStrings (8 "3.6" c32 F)) - (bcStrings (8 "3.8333" c33 F)) - (bcStrings (8 "4.1667" c34 F)) - (bcStrings (8 "4.3667" c35 F)) - (bcStrings (8 "4.4667" c36 F)) - (bcStrings (8 "4" c37 F)) - (bcStrings (8 "4.1333" c38 F)) - (bcStrings (8 "4.3667" c39 F)) - (bcStrings (8 "4.7" c40 F)) - (bcStrings (8 "4.9" c41 F)) - (bcStrings (8 "5" c42 F)) - (text . "\blankline ")) - htMakeDoneButton('"Continue",'e02defGen) - htpSetProperty(page,'m,m) - htpSetProperty(page,'px,px) - htpSetProperty(page,'py,py) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -e02defGen htPage == - m := htpProperty(htPage,'m) - px := htpProperty(htPage,'px) - py := htpProperty(htPage,'py) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - -- c - for i in 1..((px-4)*(py-4)) repeat - right := STRCONC ((first y).1," ") - y := rest y - cList := [right,:cList] - cstring := bcwords2liststring cList - -- mu - for i in 1..py repeat - right := STRCONC ((first y).1," ") - y := rest y - muList := [right,:muList] - mustring := bcwords2liststring muList - -- lamda - for i in 1..px repeat - right := STRCONC ((first y).1," ") - y := rest y - lamList := [right,:lamList] - lamstring := bcwords2liststring lamList - -- x & y - while y repeat - one := STRCONC((first y).1," ") - y := rest y - two := STRCONC((first y).1," ") - y := rest y - xlist := [two,:xlist] - ylist := [one,:ylist] - xstring := bcwords2liststring xlist - ystring := bcwords2liststring ylist - prefix := STRCONC('"e02def(",STRINGIMAGE m,", ",STRINGIMAGE px,", ") - prefix := STRCONC(prefix,STRINGIMAGE py,",[",xstring,"],[",ystring,"],[") - prefix := STRCONC(prefix,lamstring,"],[",mustring,"],[",cstring,"],") - prefix := STRCONC(prefix,STRINGIMAGE ifail,")") - linkGen prefix - - -e02dff() == - htInitPage('"E02DFF - Evaluation of a fitted bicubic spline at a mesh of points",nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXe02dff} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02dff| '|NagFittingPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "Evaluates a bicubic spline at all the points on a rectangular ") - (text . "grid defined by \htbitmap{mx} points ") - (text . "\htbitmap{xq}on the x-axis and \htbitmap{my}") - (text . "points \htbitmap{yr} on the y-axis, from its B-spline ") - (text . "representation \center{\htbitmap{e02daf}} \newline with knot sets ") - (text . "\{\lambda\} and \{\mu\}. ") - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "\newline Grid points on x-axis \htbitmap{mx}: ") - (text . "\tab{32} \menuitemstyle{}\tab{34}") - (text . "Grid points on y-axis \htbitmap{my}: ") - (text . "\newline\tab{2} ") - (bcStrings (6 7 mx PI)) - (text . "\tab{34} ") - (bcStrings (6 6 my PI)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") - (text . "Number of (interior & exterior) knots \lambda, ") - (text . "\htbitmap{px} \htbitmap{great=} 8: \newline\tab{2} ") - (bcStrings (6 11 px PI)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") - (text . "Number of (interior & exterior) knots \mu, ") - (text . "\htbitmap{py} \htbitmap{great=} 8: \newline\tab{2} ") - (bcStrings (6 10 py PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'e02dffSolve) - htShowPage() - -e02dffSolve htPage == - mx := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'mx) - objValUnwrap htpLabelSpadValue(htPage, 'mx) - my := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'my) - objValUnwrap htpLabelSpadValue(htPage, 'my) - px := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'px) - objValUnwrap htpLabelSpadValue(htPage, 'px) - py := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'py) - objValUnwrap htpLabelSpadValue(htPage, 'py) - nwrk1 := 4*mx + px - nwrk2 := 4*my + py - nwrklist := [nwrk1,nwrk2] - nwrkmin := APPLY ('MIN, nwrklist) - lwrk := nwrkmin - liwrk := - nwrkmin = nwrk2 => my + py -4 - mx + px -4 - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - ((mx = '7 and my = '6) and (px = '11 and py = '10)) => - e02dffDefaultSolve(htPage,lwrk,liwrk,ifail) - xList := - "append"/[fx(i) for i in 1..mx] where fx(i) == - xnam := INTERN STRCONC ('"x",STRINGIMAGE i) - [['bcStrings,[8, 0.0, xnam, 'F]]] - yList := - "append"/[fy(i) for i in 1..my] where fy(i) == - ynam := INTERN STRCONC ('"y",STRINGIMAGE i) - [['bcStrings,[8, 0.0, ynam, 'F]]] - prefix := ('"\blankline \menuitemstyle{} \tab{2} Enter values of ") - prefix := STRCONC(prefix,"\htbitmap{yr} : \newline") - yList := [['text,:prefix],:yList] - lamList := - "append"/[flam(i) for i in 1..px] where flam(i) == - lnam := INTERN STRCONC ('"l",STRINGIMAGE i) - [['bcStrings,[8, 0.0, lnam, 'F]]] - prefix := ('"\blankline \menuitemstyle{}\tab{2} {\it \lambda(nxest)}:\newline") - lamList := [['text,:prefix],:lamList] - muList := - "append"/[fmu(i) for i in 1..(py)] where fmu(i) == - mnam := INTERN STRCONC ('"m",STRINGIMAGE i) - [['bcStrings,[8, 0.0, mnam, 'F]]] - prefix := ('"\blankline \menuitemstyle{} \tab{2} {\it mu(nyest)}:") - prefix := STRCONC(prefix,"\newline ") - muList := [['text,:prefix],:muList] - cList := - "append"/[fp(i) for i in 1..((px-4)*(py-4))] where fp(i) == - pnam := INTERN STRCONC ('"p",STRINGIMAGE i) - [['bcStrings,[8, 0.0, pnam, 'F]]] - prefix := ('"\blankline \menuitemstyle{}\tab{2} Enter values of ") - prefix := STRCONC(prefix,"{\it c((px-4)*(py-4))}: \newline") - cList := [['text,:prefix],:cList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :xList,:yList,:lamList,:muList,:cList] - page := htInitPage('"E02DFF - Evaluation of a fitted bicubic spline at a mesh of points",nil) - htSay '"\menuitemstyle{}\tab{2} Values of \htbitmap{xr}:\newline " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'e02dffGen) - htpSetProperty(page,'mx,mx) - htpSetProperty(page,'my,my) - htpSetProperty(page,'px,px) - htpSetProperty(page,'py,py) - htpSetProperty(page,'lwrk,lwrk) - htpSetProperty(page,'liwrk,liwrk) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -e02dffDefaultSolve (htPage,lwrk,liwrk,ifail) == - mx := '7 - my := '6 - px := '11 - py := '10 - page := htInitPage('"E02DFF - Evaluation of a fitted bicubic spline at a mesh of points",nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter values of \htbitmap{xr}:") - (text . "\newline ") - (bcStrings (8 "1" x1 F)) - (bcStrings (8 "1.1" x2 F)) - (bcStrings (8 "1.3" x3 F)) - (bcStrings (8 "1.4" x4 F)) - (bcStrings (8 "1.5" x5 F)) - (bcStrings (8 "1.7" x6 F)) - (bcStrings (8 "2" x7 F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} Enter values of \htbitmap{yr}:") - (text . "\newline ") - (bcStrings (8 "0" y1 F)) - (bcStrings (8 "0.2" y2 F)) - (bcStrings (8 "0.4" y3 F)) - (bcStrings (8 "0.6" y4 F)) - (bcStrings (8 "0.8" y5 F)) - (bcStrings (8 "1" y6 F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} Enter values of {\it \lambda(nxest)}:") - (text . "\newline ") - (bcStrings (8 "1" l1 F)) - (bcStrings (8 "1" l2 F)) - (bcStrings (8 "1" l3 F)) - (bcStrings (8 "1" l4 F)) - (bcStrings (8 "1.3" l5 F)) - (bcStrings (8 "1.5" l6 F)) - (bcStrings (8 "1.6" l7 F)) - (bcStrings (8 "2" l8 F)) - (bcStrings (8 "2" l9 F)) - (bcStrings (8 "2" l10 F)) - (bcStrings (8 "2" l11 F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} Enter values of {\it \mu(nyest)}:") - (text . "\newline ") - (bcStrings (8 "0" mu1 F)) - (bcStrings (8 "0" mu2 F)) - (bcStrings (8 "0" mu3 F)) - (bcStrings (8 "0" mu4 F)) - (bcStrings (8 "0.4" mu5 F)) - (bcStrings (8 "0.7" mu6 F)) - (bcStrings (8 "1" mu7 F)) - (bcStrings (8 "1" mu8 F)) - (bcStrings (8 "1" mu9 F)) - (bcStrings (8 "1" mu10 F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} Enter values of {\it c((px-4)*(py-4))}:") - (text . "\newline ") - (bcStrings (8 "1" c1 F)) - (bcStrings (8 "1.1333" c2 F)) - (bcStrings (8 "1.3667" c3 F)) - (bcStrings (8 "1.7" c4 F)) - (bcStrings (8 "1.9" c5 F)) - (bcStrings (8 "2" c6 F)) - (bcStrings (8 "1.2" c7 F)) - (bcStrings (8 "1.3333" c8 F)) - (bcStrings (8 "1.5667" c9 F)) - (bcStrings (8 "1.9" c10 F)) - (bcStrings (8 "2.1" c11 F)) - (bcStrings (8 "2.2" c12 F)) - (bcStrings (8 "1.5833" c13 F)) - (bcStrings (8 "1.7167" c14 F)) - (bcStrings (8 "1.95" c15 F)) - (bcStrings (8 "2.2833" c16 F)) - (bcStrings (8 "2.4833" c17 F)) - (bcStrings (8 "2.5833" c18 F)) - (bcStrings (8 "2.1433" c19 F)) - (bcStrings (8 "2.2767" c20 F)) - (bcStrings (8 "2.51" c21 F)) - (bcStrings (8 "2.8433" c22 F)) - (bcStrings (8 "3.0433" c23 F)) - (bcStrings (8 "3.1433" c24 F)) - (bcStrings (8 "2.8667" c25 F)) - (bcStrings (8 "3" c26 F)) - (bcStrings (8 "3.2333" c27 F)) - (bcStrings (8 "3.5667" c28 F)) - (bcStrings (8 "3.7667" c29 F)) - (bcStrings (8 "3.8667" c30 F)) - (bcStrings (8 "3.4667" c31 F)) - (bcStrings (8 "3.6" c32 F)) - (bcStrings (8 "3.8333" c33 F)) - (bcStrings (8 "4.1667" c34 F)) - (bcStrings (8 "4.3667" c35 F)) - (bcStrings (8 "4.4667" c36 F)) - (bcStrings (8 "4" c37 F)) - (bcStrings (8 "4.1333" c38 F)) - (bcStrings (8 "4.3667" c39 F)) - (bcStrings (8 "4.7" c40 F)) - (bcStrings (8 "4.9" c41 F)) - (bcStrings (8 "5" c42 F)) - (text . "\blankline")) - htMakeDoneButton('"Continue",'e02dffGen) - htpSetProperty(page,'mx,mx) - htpSetProperty(page,'my,my) - htpSetProperty(page,'px,px) - htpSetProperty(page,'py,py) - htpSetProperty(page,'lwrk,lwrk) - htpSetProperty(page,'liwrk,liwrk) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -e02dffGen htPage == - mx := htpProperty(htPage,'mx) - my := htpProperty(htPage,'my) - px := htpProperty(htPage,'px) - py := htpProperty(htPage,'py) - lwrk := htpProperty(htPage,'lwrk) - liwrk := htpProperty(htPage,'liwrk) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - -- c - for i in 1..((px-4)*(py-4)) repeat - right := STRCONC ((first y).1," ") - y := rest y - cList := [right,:cList] - cstring := bcwords2liststring cList - -- mu - for i in 1..py repeat - right := STRCONC ((first y).1," ") - y := rest y - muList := [right,:muList] - mustring := bcwords2liststring muList - -- lamda - for i in 1..px repeat - right := STRCONC ((first y).1," ") - y := rest y - lamList := [right,:lamList] - lamstring := bcwords2liststring lamList - -- y - for i in 1..my repeat - right := STRCONC ((first y).1," ") - y := rest y - yList := [right,:yList] - ystring := bcwords2liststring yList - -- x - for i in 1..mx repeat - right := STRCONC ((first y).1," ") - y := rest y - xList := [right,:xList] - xstring := bcwords2liststring xList - prefix := STRCONC('"e02dff(",STRINGIMAGE mx,", ",STRINGIMAGE my,", ") - prefix := STRCONC(prefix,STRINGIMAGE px,", ",STRINGIMAGE py,",[") - prefix := STRCONC(prefix,xstring,"],[",ystring,"],[",lamstring,"],[") - prefix := STRCONC(prefix,mustring,"],[",cstring,"],",STRINGIMAGE lwrk,", ") - prefix := STRCONC(prefix,STRINGIMAGE liwrk,", ",STRINGIMAGE ifail,")") - linkGen prefix - -e02gaf() == - htInitPage('"E02GAF - \htbitmap{l1}-approximation by general linear function",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXe02gaf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02gaf| '|NagFittingPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "Calculates an \htbitmap{l1} solution to the over determined system") - (text . " of linear equations {\it Ax = b}, where A is an {\it m} by {\it n") - (text . "} matrix, {\it x} is an {\it n} element vector, and {\it b} is an ") - (text . "{\it m} element vector. The matrix {\it A} need not be of full ") - (text . "rank. \blankline ") - (text . "\menuitemstyle{}\tab{2} \newline ") - (text . "Number of rows of {\it A}, {\it m}: ") - (text . "\newline\tab{2} ") - (bcStrings (6 5 m PI)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} \newline ") - (text . "Number of columns of {\it A}, {\it n}: ") - (text . "\newline\tab{2} ") - (bcStrings (6 3 n PI)) --- (text . "\blankline ") --- (text . "\menuitemstyle{}\tab{2} \newline ") --- (text . "First dimension of {\it A(la,n+2)}, {\it la}\htbitmap{great=}") --- (text . " {\it m + 2}: \newline\tab{2} ") --- (bcStrings (6 7 la PI)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} \newline ") - (text . "Tolerance (default is zero), {\it toler}: ") - (text . "\newline\tab{2} ") - (bcStrings (10 "0.0" toler F)) - (text . "\blankline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'e02gafSolve) - htShowPage() - -e02gafSolve htPage == - m := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) - objValUnwrap htpLabelSpadValue(htPage, 'm) - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - la := m+2 --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'la) --- objValUnwrap htpLabelSpadValue(htPage, 'la) - toler := htpLabelInputString(htPage,'toler) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - ((m = 5 and n = 3) and la = 7) => e02gafDefaultSolve (htPage,toler,ifail) - labelList := - "append"/[fc(i,n) for i in 1..la] where fc(i,n) == - tempList := - "append"/[fr(i,j) for j in 1..(n+2)] where fr(i,j) == - fnam := INTERN STRCONC ('"f",STRINGIMAGE i, STRINGIMAGE j) - [['bcStrings,[9, 0.0, fnam, 'F]]] - prefix := ('"\newline ") - tempList := [['text,:prefix],:tempList] - bList := - "append"/[fb(i) for i in 1..m] where fb(i) == - lnam := INTERN STRCONC ('"l",STRINGIMAGE i) - [['bcStrings,[9, 0.0, lnam, 'F]]] - prefix := ('"\blankline \menuitemstyle{} \tab{2} Values of {\it B(m)}: \newline") - bList := [['text,:prefix],:bList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :labelList,:bList] - page := htInitPage('"E02GAF - \htbitmap{l1}-approximation by general linear function",nil) - htSay '"\menuitemstyle{}\tab{2} Values of {\it A(la,n+2)}:" - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'e02gafGen) - htpSetProperty(page,'m,m) - htpSetProperty(page,'n,n) - htpSetProperty(page,'la,la) - htpSetProperty(page,'toler,toler) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -e02gafDefaultSolve (htPage,toler,ifail) == - m := '5 - n := '3 - la := '7 - page := htInitPage('"E02GAF - \htbitmap{l1}-approximation by general linear function",nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Values of {\it A(la,n+2)}:") - (text . "\newline ") - (bcStrings (9 "1.0" a11 F)) - (bcStrings (9 "1.0" a12 F)) - (bcStrings (9 "1.0" a13 F)) - (bcStrings (9 "0.0" a14 F)) - (bcStrings (9 "0.0" a15 F)) - (text . "\newline ") - (bcStrings (9 "exp(0.2)" a21 F)) - (bcStrings (9 "exp(-0.2)" a22 F)) - (bcStrings (9 "1.0" a23 F)) - (bcStrings (9 "0.0" a24 F)) - (bcStrings (9 "0.0" a25 F)) - (text . "\newline ") - (bcStrings (9 "exp(0.4)" a31 F)) - (bcStrings (9 "exp(-0.4)" a32 F)) - (bcStrings (9 "1.0" a33 F)) - (bcStrings (9 "0.0" a34 F)) - (bcStrings (9 "0.0" a35 F)) - (text . "\newline ") - (bcStrings (9 "exp(0.6)" a41 F)) - (bcStrings (9 "exp(-0.6)" a42 F)) - (bcStrings (9 "1.0" a43 F)) - (bcStrings (9 "0.0" a44 F)) - (bcStrings (9 "0.0" a45 F)) - (text . "\newline ") - (bcStrings (9 "exp(0.8)" a51 F)) - (bcStrings (9 "exp(-0.8)" a52 F)) - (bcStrings (9 "1.0" a53 F)) - (bcStrings (9 "0.0" a54 F)) - (bcStrings (9 "0.0" a55 F)) - (text . "\newline ") - (bcStrings (9 "0.0" a61 F)) - (bcStrings (9 "0.0" a62 F)) - (bcStrings (9 "0.0" a63 F)) - (bcStrings (9 "0.0" a64 F)) - (bcStrings (9 "0.0" a65 F)) - (text . "\newline ") - (bcStrings (9 "0.0" a71 F)) - (bcStrings (9 "0.0" a72 F)) - (bcStrings (9 "0.0" a73 F)) - (bcStrings (9 "0.0" a74 F)) - (bcStrings (9 "0.0" a75 F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} Values of {\it B(m)}:") - (text . "\newline ") - (bcStrings (9 "4.501" b1 F)) - (bcStrings (9 "4.36" b2 F)) - (bcStrings (9 "4.333" b3 F)) - (bcStrings (9 "4.418" b4 F)) - (bcStrings (9 "4.625" b5 F))) - htMakeDoneButton('"Continue",'e02gafGen) - htpSetProperty(page,'m,m) - htpSetProperty(page,'n,n) - htpSetProperty(page,'toler,toler) - htpSetProperty(page,'la,la) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -e02gafGen htPage == - m := htpProperty(htPage,'m) - n := htpProperty(htPage,'n) - la := htpProperty(htPage,'la) - toler := htpProperty(htPage,'toler) - ifail := htpProperty(htPage,'ifail) - nplustwo := n + 2 - alist := htpInputAreaAlist htPage - y := alist - for i in 1..m repeat - right := STRCONC ((first y).1," ") - y := rest y - blist := [right,:blist] - bstring := bcwords2liststring blist - y := REVERSE y - k := -1 - matform := [[y.(k := k + 1).1 for j in 0..(nplustwo-1)] for i in 0..(la-1)] - matstring := bcwords2liststring [bcwords2liststring x for x in matform] - prefix := STRCONC('"e02gaf(",STRINGIMAGE m,", ",STRINGIMAGE la,", ") - prefix := STRCONC(prefix,STRINGIMAGE nplustwo,", ",STRINGIMAGE toler,", ") - prefix := STRCONC(prefix,matstring,",[",bstring,"], ") - prefix := STRCONC(prefix,STRINGIMAGE ifail,")") - linkGen prefix - - -e02daf() == - htInitPage('"E02DAF - Least-squares surface fit, bicubic splines",nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXe02daf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02daf| '|NagFittingPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "Determines a minimal, least squares bicubic B-spline surface fit") - (text . "\htbitmap{e02daf} to the set of points ") - (text . "{\em (\htbitmap{xr},\htbitmap{yr},\htbitmap{fr})} with weights ") - (text . "\htbitmap{wr}, for r = 1,2,...,m. The user must supply internal ") - (text . "knot sets {\lambda},in the x-direction and {\mu} in the ") - (text . "y-direction, ") - (text . "which can be thought of as dividing the data region into panels;") - (text . "s(x,y) consists of a seperate bicubic polynomial in each panel, ") - (text . "the polynomial joining together with second derivative ") - (text . "continuity. Eight additional (external) knots are added to each ") - (text . "of the knot sets by this routine. The routine minimizes \Sigma, ") - (text . "the sum of squares of the weighted residuals ") - (text . "\htbitmap{e02daf1}, for r = 1,2,...,m, subject to the ") - (text . "given knot sets. \newline ") - (text . "A call of this routine should be preceded by a call of E02ZAF ") - (text . "to provide indexing information. ") - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} \newline ") - (text . "Number of data points {\it m}: ") - (text . "\newline\tab{2} ") - (bcStrings (6 30 m PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "\newline Knots in x direction {\em px}") - (text . "\htbitmap{great=} 8: \tab{32} \menuitemstyle{}\tab{34}") - (text . "Knots in y direction {\em py}:") - (text . "\newline\tab{2} ") - (bcStrings (6 8 px PI)) - (text . "\tab{34} ") - (bcStrings (6 10 py PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "\newline Rank threshold {\em eps}:") - (text . "\newline\tab{2} ") - (bcStrings (10 "0.000001" eps F)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} \newline ") - (text . "Dimension of point {\it npoint}: ") - (text . "\newline\tab{2} ") - (bcStrings (6 43 npoint PI)) - -- include a radio button later to allow switching of - -- x & y if px <= py - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'e02dafSolve) - htShowPage() - -e02dafSolve htPage == - m := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) - objValUnwrap htpLabelSpadValue(htPage, 'm) - px := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'px) - objValUnwrap htpLabelSpadValue(htPage, 'px) - py := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'py) - objValUnwrap htpLabelSpadValue(htPage, 'py) - npoint := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'npoint) - objValUnwrap htpLabelSpadValue(htPage, 'npoint) - nc := (px - 4)*(py - 4) - nws := (2*nc + 1)*(3*py - 6) -2 - eps := htpLabelInputString(htPage,'eps) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - ((m = '30 and px = '8) and py = '10) => e02dafDefaultSolve(htPage,eps,nws,npoint,ifail) - labelList := - "append"/[fxy(i) for i in 1..m] where fxy(i) == - prefix := ('"\newline \tab{2} ") - middle := ('"\tab{17} ") - next := ('"\tab{32} ") - end := ('"\tab{47} ") - xnam := INTERN STRCONC ('"x",STRINGIMAGE i) - ynam := INTERN STRCONC ('"y",STRINGIMAGE i) - fnam := INTERN STRCONC ('"f",STRINGIMAGE i) - wnam := INTERN STRCONC ('"w",STRINGIMAGE i) - [['text,:prefix],['bcStrings,[8, 0.0, xnam, 'F]], - ['text,:middle],['bcStrings,[8, 0.0, ynam, 'F]], - ['text,:next],['bcStrings,[8, 0.0, fnam, 'F]], - ['text,:end],['bcStrings,[8, 0.0, wnam, 'F]]] - lamList := - "append"/[flam(i) for i in 5..(px-4)] where flam(i) == - lnam := INTERN STRCONC ('"l",STRINGIMAGE i) - [['bcStrings,[8, 0.0, lnam, 'F]]] - prefix := ('"\blankline \menuitemstyle{} \tab{2} lamda(5) to lamda(px-4): ") - prefix := STRCONC(prefix,"\newline \tab{2} ") - postfix := ('"\newline \blankline ") - lamList := [['text,:prefix],:lamList,['text,:postfix]] - muList := - "append"/[fmu(i) for i in 5..(py-4)] where fmu(i) == - mnam := INTERN STRCONC ('"m",STRINGIMAGE i) - [['bcStrings,[8, 0.0, mnam, 'F]]] - prefix := ('"\menuitemstyle{} \tab{2} mu(5) to mu(py-4):") - prefix := STRCONC(prefix,"\newline \tab{2} ") - muList := [['text,:prefix],:muList] - pList := - "append"/[fp(i) for i in 1..npoint] where fp(i) == - prefix := ('"\newline \tab{2} ") - pnam := INTERN STRCONC ('"p",STRINGIMAGE i) - [['text,:prefix],['bcStrings,[8, 0.0, pnam, 'F]]] - prefix := ('"\blankline \menuitemstyle{} \tab{2} Enter values of Point: ") - pList := [['text,:prefix],:pList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :labelList,:lamList,:muList,:pList] - page := htInitPage('"E02DAF - Least-squares surface fit, bicubic splines",nil) - htSay '"\menuitemstyle{}\tab{2} Values of \htbitmap{xr}: " - htSay '"\tab{15} \menuitemstyle{}\tab{17} Values of \htbitmap{yr}:" - htSay '"\tab{30} \menuitemstyle{}\tab{32} Values of \htbitmap{fr}:" - htSay '"\tab{44} \menuitemstyle{}\tab{46} Values of \htbitmap{wr}:" - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'e02dafGen) - htpSetProperty(page,'m,m) - htpSetProperty(page,'px,px) - htpSetProperty(page,'py,py) - htpSetProperty(page,'nws,nws) - htpSetProperty(page,'eps,eps) - htpSetProperty(page,'npoint,npoint) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -e02dafDefaultSolve (htPage,eps,nws,npoint,ifail) == - m := '30 - px := '8 - py := '10 - page := htInitPage('"E02DAF - Least-squares surface fit, bicubic splines",nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Values of \htbitmap{xr}:") - (text . "\tab{15} \menuitemstyle{} \tab{17} Values of ") - (text . "\htbitmap{yr}: \tab{30} \menuitemstyle{} \tab{32} ") - (text . "Values of \htbitmap{fr}: \tab{44} \menuitemstyle{} ") - (text . "\tab{46} Values of \htbitmap{wr}:") - (text . "\newline \tab{2} ") - (bcStrings (8 "-0.52" x1 F)) - (text . "\tab{17}") - (bcStrings (8 "0.60" y1 F)) - (text . "\tab{32}") - (bcStrings (8 "0.93" f1 F)) - (text . "\tab{47}") - (bcStrings (8 "10" w1 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "-0.61" x2 F)) - (text . "\tab{17}") - (bcStrings (8 "-0.95" y2 F)) - (text . "\tab{32}") - (bcStrings (8 "-1.79" f2 F)) - (text . "\tab{47}") - (bcStrings (8 "10" w2 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "0.93" x3 F)) - (text . "\tab{17}") - (bcStrings (8 "0.87" y3 F)) - (text . "\tab{32}") - (bcStrings (8 "0.36" f3 F)) - (text . "\tab{47}") - (bcStrings (8 "10" w3 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "0.09" x4 F)) - (text . "\tab{17}") - (bcStrings (8 "0.84" y4 F)) - (text . "\tab{32}") - (bcStrings (8 "0.52" f4 F)) - (text . "\tab{47}") - (bcStrings (8 "10" w4 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "0.88" x5 F)) - (text . "\tab{17}") - (bcStrings (8 "0.17" y5 F)) - (text . "\tab{32}") - (bcStrings (8 "0.49" f5 F)) - (text . "\tab{47}") - (bcStrings (8 "10" w5 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "-0.70" x6 F)) - (text . "\tab{17}") - (bcStrings (8 "-0.87" y6 F)) - (text . "\tab{32}") - (bcStrings (8 "-1.76" f6 F)) - (text . "\tab{47}") - (bcStrings (8 "10" w6 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "1" x7 F)) - (text . "\tab{17}") - (bcStrings (8 "1" y7 F)) - (text . "\tab{32}") - (bcStrings (8 "0.33" f7 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w7 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "1" x8 F)) - (text . "\tab{17}") - (bcStrings (8 "0.1" y8 F)) - (text . "\tab{32}") - (bcStrings (8 "0.48" f8 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w8 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "0.3" x9 F)) - (text . "\tab{17}") - (bcStrings (8 "0.24" y9 F)) - (text . "\tab{32}") - (bcStrings (8 "0.65" f9 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w9 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "-0.77" x10 F)) - (text . "\tab{17}") - (bcStrings (8 "-0.77" y10 F)) - (text . "\tab{32}") - (bcStrings (8 "-1.82" f10 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w10 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "-0.23" x11 F)) - (text . "\tab{17}") - (bcStrings (8 "0.32" y11 F)) - (text . "\tab{32}") - (bcStrings (8 "0.92" f11 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w11 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "-1" x12 F)) - (text . "\tab{17}") - (bcStrings (8 "1" y12 F)) - (text . "\tab{32}") - (bcStrings (8 "1" f12 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w12 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "-0.26" x13 F)) - (text . "\tab{17}") - (bcStrings (8 "-0.63" y13 F)) - (text . "\tab{32}") - (bcStrings (8 "8.88" f13 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w13 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "-0.83" x14 F)) - (text . "\tab{17}") - (bcStrings (8 "-0.66" y14 F)) - (text . "\tab{32}") - (bcStrings (8 "-2.01" f14 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w14 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "0.22" x15 F)) - (text . "\tab{17}") - (bcStrings (8 "0.93" y15 F)) - (text . "\tab{32}") - (bcStrings (8 "0.47" f15 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w15 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "0.89" x16 F)) - (text . "\tab{17}") - (bcStrings (8 "0.15" y16 F)) - (text . "\tab{32}") - (bcStrings (8 "0.49" f16 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w16 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "-0.80" x17 F)) - (text . "\tab{17}") - (bcStrings (8 "0.99" y17 F)) - (text . "\tab{32}") - (bcStrings (8 "0.84" f17 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w17 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "-0.88" x18 F)) - (text . "\tab{17}") - (bcStrings (8 "-0.54" y18 F)) - (text . "\tab{32}") - (bcStrings (8 "-2.42" f18 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w18 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "0.68" x19 F)) - (text . "\tab{17}") - (bcStrings (8 "0.44" y19 F)) - (text . "\tab{32}") - (bcStrings (8 "0.47" f19 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w19 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "-0.14" x20 F)) - (text . "\tab{17}") - (bcStrings (8 "-0.72" y20 F)) - (text . "\tab{32}") - (bcStrings (8 "7.15" f20 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w20 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "0.67" x21 F)) - (text . "\tab{17}") - (bcStrings (8 "0.63" y21 F)) - (text . "\tab{32}") - (bcStrings (8 "0.44" f21 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w21 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "-0.90" x22 F)) - (text . "\tab{17}") - (bcStrings (8 "-0.40" y22 F)) - (text . "\tab{32}") - (bcStrings (8 "-3.34" f22 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w22 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "-0.84" x23 F)) - (text . "\tab{17}") - (bcStrings (8 "0.20" y23 F)) - (text . "\tab{32}") - (bcStrings (8 "2.78" f23 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w23 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "0.84" x24 F)) - (text . "\tab{17}") - (bcStrings (8 "0.43" y24 F)) - (text . "\tab{32}") - (bcStrings (8 "0.44" f24 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w24 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "0.15" x25 F)) - (text . "\tab{17}") - (bcStrings (8 "0.28" y25 F)) - (text . "\tab{32}") - (bcStrings (8 "0.70" f25 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w25 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "-0.91" x26 F)) - (text . "\tab{17}") - (bcStrings (8 "-0.24" y26 F)) - (text . "\tab{32}") - (bcStrings (8 "-6.52" f26 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w26 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "-0.35" x27 F)) - (text . "\tab{17}") - (bcStrings (8 "0.86" y27 F)) - (text . "\tab{32}") - (bcStrings (8 "0.66" f27 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w27 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "-0.16" x28 F)) - (text . "\tab{17}") - (bcStrings (8 "-0.41" y28 F)) - (text . "\tab{32}") - (bcStrings (8 "2.32" f28 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w28 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "-0.35" x29 F)) - (text . "\tab{17}") - (bcStrings (8 "-0.05" y29 F)) - (text . "\tab{32}") - (bcStrings (8 "1.66" f29 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w29 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "-1" x30 F)) - (text . "\tab{17}") - (bcStrings (8 "-1" y30 F)) - (text . "\tab{32}") - (bcStrings (8 "-1" f30 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w30 F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} mu(5) to mu(py-4):") - (text . "\newline \tab{2}") - (bcStrings (8 "-0.50" mu5 F)) - (bcStrings (8 "0.00" mu6 F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} Enter values for point:") - (text . "\newline \tab{2}") - (bcStrings (6 3 p1 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 6 p2 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 4 p3 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 5 p4 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 7 p5 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 10 p6 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 8 p7 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 9 p8 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 11 p9 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 13 p10 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 12 p11 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 15 p12 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 14 p13 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 18 p14 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 16 p15 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 17 p16 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 19 p17 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 20 p18 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 21 p19 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 30 p20 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 23 p21 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 26 p22 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 24 p23 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 25 p24 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 27 p25 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 28 p26 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 0 p27 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 29 p28 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 0 p29 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 0 p30 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 2 p31 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 22 p32 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 1 p33 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 0 p34 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 0 p35 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 0 p36 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 0 p37 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 0 p38 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 0 p39 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 0 p40 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 0 p41 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 0 p42 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 0 p43 PI)) - (text . "\blankline")) - htMakeDoneButton('"Continue",'e02dafGen) - htpSetProperty(page,'m,m) - htpSetProperty(page,'px,px) - htpSetProperty(page,'py,py) - htpSetProperty(page,'nws,nws) - htpSetProperty(page,'eps,eps) - htpSetProperty(page,'npoint,npoint) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -e02dafGen htPage == - m := htpProperty(htPage,'m) - px := htpProperty(htPage,'px) - py := htpProperty(htPage,'py) - nws := htpProperty(htPage,'nws) - eps := htpProperty(htPage,'eps) - npoint := htpProperty(htPage,'npoint) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - nadres := (px-7)*(py-7) - -- point - for i in 1..npoint repeat - right := STRCONC ((first y).1," ") - y := rest y - pointList := [right,:pointList] - pstring := bcwords2liststring pointList - -- mu - for i in 1..4 repeat - muList := ['"0 ",:muList] - for i in 5..(py-4) repeat - right := STRCONC ((first y).1," ") - y := rest y - muList := [right,:muList] - for i in (py-3)..py repeat - muList := ['"0 ",:muList] - mustring := bcwords2liststring muList - -- lamda - for i in 1..4 repeat - lamList := ['"0 ",:lamList] - for i in 5..(px-4) repeat - right := STRCONC ((first y).1," ") - y := rest y - lamList := [right,:lamList] - for i in (px-3)..px repeat - lamList := ['"0 ",:lamList] - lamstring := bcwords2liststring lamList - -- x & y - while y repeat - one := STRCONC((first y).1," ") - y := rest y - two := STRCONC((first y).1," ") - y := rest y - three := STRCONC ((first y).1," ") - y := rest y - four := STRCONC ((first y).1," ") - y := rest y - xlist := [four,:xlist] - ylist := [three,:ylist] - flist := [two,:flist] - wlist := [one,:wlist] - xstring := bcwords2liststring xlist - ystring := bcwords2liststring ylist - fstring := bcwords2liststring flist - wstring := bcwords2liststring wlist - nc := (px-4)*(py-4) - prefix := STRCONC('"e02daf(",STRINGIMAGE m,", ",STRINGIMAGE px,", ") - prefix := STRCONC(prefix,STRINGIMAGE py,",[",xstring,"],[",ystring,"],[") - prefix := STRCONC(prefix,fstring,"],[",wstring,"],[",mustring,"],[") - prefix := STRCONC(prefix,pstring,"], ",STRINGIMAGE npoint,", ") - prefix := STRCONC(prefix,STRINGIMAGE nc,", ",STRINGIMAGE nws,", ",eps,", [") - prefix := STRCONC(prefix,lamstring,"], ",STRINGIMAGE ifail,")") - linkGen prefix - - -e02dcf() == - htInitPage('"E02DCF - Least-squares curve by bicubic splines with automatic knot placement, data on a rectangular grid",nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXe02dcf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02dcf| '|NagFittingPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "Determines a bicubic spline approximation to a set of points ") - (text . "given on a rectangular grid defined by \htbitmap{mx} ") - (text . "points \htbitmap{xq} on the x-axis and ") - (text . "\htbitmap{my} points \htbitmap{yr} on the ") - (text . "y-axix. The knots \htbitmap{lamdai}, for i = 1,2,...,") - (text . "\htbitmap{nx} and \htbitmap{mui}, for ") - (text . "i = 1,2,...,\htbitmap{ny} are chosen for this routine ") - (text . ", but a single parameter S must be specified to control the ") - (text . "trade-off between closeness of fit and smoothness of fit. This ") - (text . "affects the number of knots required by the spline, which is ") - (text . "given in the B-spline representation \htbitmap{e02daf}") - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} \newline ") - (text . "Grid points on x-axis \htbitmap{mx}: ") - (text . "\tab{30} \menuitemstyle{}\tab{32} Grid points on y-axis ") - (text . "\htbitmap{my}: ") - (text . "\newline\tab{2} ") - (bcStrings (6 11 mx PI)) - (text . "\tab{32} ") - (bcStrings (6 9 my PI)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") - (text . "Over-estimate of \htbitmap{nx} of knots \lambda of the ") - (text . "computed spline, {\it nxest}: \newline\tab{2} ") - (bcStrings (6 15 nxest PI)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") - (text . "Over-estimate of \htbitmap{ny} of knots \mu of the computed ") - (text . "spline, {\it nyest}: \newline\tab{2} ") - (bcStrings (6 13 nyest PI)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} \newline ") - (text . "Smoothing factor {\it s}: ") - (text . "\newline\tab{2} ") - (bcStrings (6 "0.1" s F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Start value: ") - (radioButtons start - ("" " Cold Start - no values needed for {\it nx,ny,lamda,mu} or {\it iwrk}" cold) - ("" " Warm Start - uses knots found in a previous call" warm)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'e02dcfSolve) - htShowPage() - -e02dcfSolve htPage == - mx := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'mx) - objValUnwrap htpLabelSpadValue(htPage, 'mx) - my := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'my) - objValUnwrap htpLabelSpadValue(htPage, 'my) - nxest := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nxest) - objValUnwrap htpLabelSpadValue(htPage, 'nxest) - nyest := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nyest) - objValUnwrap htpLabelSpadValue(htPage, 'nyest) - wrklist := [my,nxest] - wrkmax := APPLY ('MAX, wrklist) - lwrk := 4*(mx + my) +11*(nxest + nyest) + nxest*my + wrkmax +54 - liwrk := 3 + mx + my + nxest + nyest - s := htpLabelInputString(htPage,'s) - initial := htpButtonValue(htPage,'start) - start := - initial = 'cold => '1 - '2 - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - ((mx = 11 and my = 9) and start = 1) => - e02dcfDefaultSolve (htPage,nxest,nyest,lwrk,liwrk,s,ifail) - start = 1 => e02dcfColdSolve (htPage,mx,my,nxest,nyest,lwrk,liwrk,s,ifail) - -- warm start not really possible from hyperdoc - -- as inputing a workspace array of dimension 592 is asking too much - -- user should use the command line, using the previous calculated - -- parameters - htInitPage('"E02DCF - Least-squares curve by bicubic splines with automatic knot placement, data on a rectangular grid",nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\blankline ") - (text . "{\center{\em Hyperdoc interface not available for warm starts.}}") - (text . "\newline ") - (text . "{\center{\em Please use the command line.}}")) - htMakeDoneButton('"Continue",'e02dcf) - htShowPage() - - - -e02dcfColdSolve(htPage,mx,my,nxest,nyest,lwrk,liwrk,s,ifail) == - xList := - "append"/[f(i) for i in 1..mx] where f(i) == - xnam := INTERN STRCONC ('"x",STRINGIMAGE i) - [['bcStrings,[8, 0.0, xnam, 'F]]] - yList := - "append"/[g(i) for i in 1..my] where g(i) == - ynam := INTERN STRCONC ('"g",STRINGIMAGE i) - [['bcStrings,[8, 0.0, ynam, 'F]]] - prefix:= ('"\blankline \menuitemstyle{}\tab{2} Values of {\it y(my)}: \newline ") - yList := [['text,:prefix],:yList] - fList := - "append"/[h(i) for i in 1..(mx*my)] where h(i) == - fnam := INTERN STRCONC ('"g",STRINGIMAGE i) - [['bcStrings,[8, 0.0, fnam, 'F]]] - prefix:=('"\blankline \menuitemstyle{} \tab{2} Values of {\it f(mx*my)}: \newline ") - fList := [['text,:prefix],:fList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :xList,:yList,:fList] - page := htInitPage('"E02DCF - Least-squares curve by bicubic splines with automatic knot placement, data on a rectangular grid",nil) - htSay '"\menuitemstyle{}\tab{2} Values of {\it x(mx)}: \newline " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'e02dcfColdGen) - htpSetProperty(page,'mx,mx) - htpSetProperty(page,'my,my) - htpSetProperty(page,'nxest,nxest) - htpSetProperty(page,'nyest,nyest) - htpSetProperty(page,'lwrk,lwrk) - htpSetProperty(page,'liwrk,liwrk) - htpSetProperty(page,'s,s) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -e02dcfDefaultSolve (htPage,nxest,nyest,lwrk,liwrk,s,ifail) == - mx := 11 - my := 9 - page := htInitPage('"E02DCF - Least-squares curve by bicubic splines with automatic knot placement, data on a rectangular grid",nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Values of {\it x(mx)}:") - (text . "\newline ") - (bcStrings (8 "0" x1 F)) - (bcStrings (8 "0.5" x2 F)) - (bcStrings (8 "1" x3 F)) - (bcStrings (8 "1.5" x4 F)) - (bcStrings (8 "2" x5 F)) - (bcStrings (8 "2.5" x6 F)) - (bcStrings (8 "3" x7 F)) - (bcStrings (8 "3.5" x8 F)) - (bcStrings (8 "4" x9 F)) - (bcStrings (8 "4.5" x10 F)) - (bcStrings (8 "5" x11 F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} Values of {\it y(my)}:") - (text . "\newline ") - (bcStrings (8 "0" y1 F)) - (bcStrings (8 "0.5" y2 F)) - (bcStrings (8 "1" y3 F)) - (bcStrings (8 "1.5" y4 F)) - (bcStrings (8 "2" y5 F)) - (bcStrings (8 "2.5" y6 F)) - (bcStrings (8 "3" y7 F)) - (bcStrings (8 "3.5" y8 F)) - (bcStrings (8 "4" y9 F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} Values of {\it f(mx*my)}:") - (text . "\newline ") - (bcStrings (8 "1" f1 F)) - (bcStrings (8 "0.88758" f2 F)) - (bcStrings (8 "0.5403" f3 F)) - (bcStrings (8 "0.070737" f4 F)) - (bcStrings (8 "-0.41515" f5 F)) - (bcStrings (8 "-0.80114" f6 F)) - (bcStrings (8 "-0.97999" f7 F)) - (bcStrings (8 "-0.93446" f8 F)) - (bcStrings (8 "-0.65664" f9 F)) - (bcStrings (8 "1.5" f10 F)) - (bcStrings (8 "1.3564" f11 F)) - (bcStrings (8 "0.82045" f12 F)) - (bcStrings (8 "0.10611" f13 F)) - (bcStrings (8 "-0.62422" f14 F)) - (bcStrings (8 "-1.2317" f15 F)) - (bcStrings (8 "-1.485" f16 F)) - (bcStrings (8 "-1.3047" f17 F)) - (bcStrings (8 "-0.98547" f18 F)) - (bcStrings (8 "2.06" f19 F)) - (bcStrings (8 "1.7552" f20 F)) - (bcStrings (8 "1.0806" f21 F)) - (bcStrings (8 "0.15147" f22 F)) - (bcStrings (8 "-0.83229" f23 F)) - (bcStrings (8 "-1.6023" f24 F)) - (bcStrings (8 "-1.97" f25 F)) - (bcStrings (8 "-1.8729" f26 F)) - (bcStrings (8 "-1.4073" f27 F)) - (bcStrings (8 "2.57" f28 F)) - (bcStrings (8 "2.124" f29 F)) - (bcStrings (8 "1.3508" f30 F)) - (bcStrings (8 "0.17684" f31 F)) - (bcStrings (8 "-1.0404" f32 F)) - (bcStrings (8 "-2.0029" f33 F)) - (bcStrings (8 "-2.475" f34 F)) - (bcStrings (8 "-2.3511" f35 F)) - (bcStrings (8 "-1.6741" f36 F)) - (bcStrings (8 "3" f37 F)) - (bcStrings (8 "2.6427" f38 F)) - (bcStrings (8 "1.6309" f39 F)) - (bcStrings (8 "0.21221" f40 F)) - (bcStrings (8 "-1.2484" f41 F)) - (bcStrings (8 "-2.2034" f42 F)) - (bcStrings (8 "-2.97" f43 F)) - (bcStrings (8 "-2.8094" f44 F)) - (bcStrings (8 "-1.9809" f45 F)) - (bcStrings (8 "3.5" f46 F)) - (bcStrings (8 "3.1715" f47 F)) - (bcStrings (8 "1.8611" f48 F)) - (bcStrings (8 "0.24458" f49 F)) - (bcStrings (8 "-1.4565" f50 F)) - (bcStrings (8 "-2.864" f51 F)) - (bcStrings (8 "-3.265" f52 F)) - (bcStrings (8 "-3.2776" f53 F)) - (bcStrings (8 "-2.2878" f54 F)) - (bcStrings (8 "4.04" f55 F)) - (bcStrings (8 "3.5103" f56 F)) - (bcStrings (8 "2.0612" f57 F)) - (bcStrings (8 "0.28595" f58 F)) - (bcStrings (8 "-1.6946" f59 F)) - (bcStrings (8 "-3.2046" f60 F)) - (bcStrings (8 "-3.96" f61 F)) - (bcStrings (8 "-3.7958" f62 F)) - (bcStrings (8 "-2.6146" f63 F)) - (bcStrings (8 "4.5" f64 F)) - (bcStrings (8 "3.9391" f65 F)) - (bcStrings (8 "2.4314" f66 F)) - (bcStrings (8 "0.31632" f67 F)) - (bcStrings (8 "-1.8627" f68 F)) - (bcStrings (8 "-3.6351" f69 F)) - (bcStrings (8 "-4.455" f70 F)) - (bcStrings (8 "-4.2141" f71 F)) - (bcStrings (8 "-2.9314" f72 F)) - (bcStrings (8 "5.04" f73 F)) - (bcStrings (8 "4.3879" f74 F)) - (bcStrings (8 "2.7515" f75 F)) - (bcStrings (8 "0.35369" f76 F)) - (bcStrings (8 "-2.0707" f77 F)) - (bcStrings (8 "-4.0057" f78 F)) - (bcStrings (8 "-4.97" f79 F)) - (bcStrings (8 "-4.6823" f80 F)) - (bcStrings (8 "-3.2382" f81 F)) - (bcStrings (8 "5.505" f82 F)) - (bcStrings (8 "4.8367" f83 F)) - (bcStrings (8 "2.9717" f84 F)) - (bcStrings (8 "0.38505" f85 F)) - (bcStrings (8 "-2.2888" f86 F)) - (bcStrings (8 "-4.4033" f87 F)) - (bcStrings (8 "-5.445" f88 F)) - (bcStrings (8 "-5.1405" f89 F)) - (bcStrings (8 "-3.595" f90 F)) - (bcStrings (8 "6" f91 F)) - (bcStrings (8 "5.2755" f92 F)) - (bcStrings (8 "3.2418" f93 F)) - (bcStrings (8 "0.42442" f94 F)) - (bcStrings (8 "-2.4769" f95 F)) - (bcStrings (8 "-4.8169" f96 F)) - (bcStrings (8 "-5.93" f97 F)) - (bcStrings (8 "-5.6387" f98 F)) - (bcStrings (8 "-3.9319" f99 F))) - htMakeDoneButton('"Continue",'e02dcfColdGen) - htpSetProperty(page,'mx,mx) - htpSetProperty(page,'my,my) - htpSetProperty(page,'nxest,nxest) - htpSetProperty(page,'nyest,nyest) - htpSetProperty(page,'lwrk,lwrk) - htpSetProperty(page,'liwrk,liwrk) - htpSetProperty(page,'s,s) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -e02dcfColdGen htPage == - mx := htpProperty(htPage,'mx) - my := htpProperty(htPage,'my) - nxest := htpProperty(htPage,'nxest) - nyest := htpProperty(htPage,'nyest) - lwrk := htpProperty(htPage,'lwrk) - liwrk := htpProperty(htPage,'liwrk) - s := htpProperty(htPage,'s) - cold := '"c" - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - for i in 1..(mx*my) repeat - end := STRCONC((first y).1," ") - y := rest y - fList := [end,:fList] - fstring := bcwords2liststring fList - for i in 1..my repeat - mid := STRCONC ((first y).1," ") - y := rest y - ylist := [mid,:ylist] - ystring := bcwords2liststring ylist - while y repeat - start := STRCONC ((first y).1," ") - y := rest y - xlist := [start,:xlist] - xstring := bcwords2liststring xlist - -- additional entries needed to get it running - -- but as Start = c they are not used - prefix := STRCONC('"e02dcf(_"",cold,"_",",STRINGIMAGE mx,", [",xstring,"],") - prefix := STRCONC(prefix,STRINGIMAGE my,",[",ystring,"],[",fstring,"], ") - prefix := STRCONC(prefix,STRINGIMAGE s,", ",STRINGIMAGE nxest,", ") - prefix := STRCONC(prefix,STRINGIMAGE nyest,", ",STRINGIMAGE lwrk,", ") - prefix := STRCONC(prefix,STRINGIMAGE liwrk,",0,new(1,", STRINGIMAGE nxest,",0.0)$MATRIX DFLOAT,") - prefix := STRCONC(prefix,"0,new(1,", STRINGIMAGE nyest,",0.0)$MATRIX DFLOAT,") - end := STRCONC("new(1,", STRINGIMAGE lwrk,",0.0)$MATRIX DFLOAT,[[0 for i in 1..") - end := STRCONC(end,STRINGIMAGE liwrk,"]]::Matrix Integer,",STRINGIMAGE ifail,")") - linkGen STRCONC(prefix,end) - - -e02ddf() == - htInitPage('"E02DDF - Least-squares surface fit by bicubic splines with automatic knot placement, scattered data",nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXe02ddf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02ddf| '|NagFittingPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "Determines a bicubic spline approximation to a set of scattered") - (text . " points ( \htbitmap{xr},\htbitmap{yr}, ") - (text . "\htbitmap{fr})") - (text . "with weights \htbitmap{wr}, for r = 1,2,...,m. ") - (text . "The knots \htbitmap{lamdai}, for i = 1,2,...,") - (text . "\htbitmap{nx} and \htbitmap{mui}, for ") - (text . "i = 1,2,...,\htbitmap{ny} are chosen by the routine ") - (text . ", but a single parameter S must be specified to control the ") - (text . "trade-off between closeness of fit and smoothness of fit. This ") - (text . "affects the number of knots required by the spline, which is ") - (text . "given in the B-spline representation \htbitmap{e02daf}") - (text . "\newline \menuitemstyle{}\tab{2} \newline ") - (text . "Number of data points {\it m}: ") - (text . "\newline\tab{2} ") - (bcStrings (6 30 m PI)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") - (text . "Over-estimate of \htbitmap{nx} of knots \lambda of the ") - (text . "computed spline, {\it nxest}: \newline\tab{2} ") - (bcStrings (6 14 nxest PI)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") - (text . "Over-estimate of \htbitmap{ny} of knots \mu of the computed ") - (text . "spline, {\it nyest}: \newline\tab{2} ") - (bcStrings (6 14 nyest PI)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} \newline ") - (text . "Smoothing factor {\it s}: ") - (text . "\newline\tab{2} ") - (bcStrings (6 "10" s F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Start value: ") - (radioButtons start - ("" " Cold Start - no values needed for {\it nx,ny,lamda,wrk,iwrk}" cold) - ("" " Warm Start - uses knots found in a previous call" warm)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'e02ddfSolve) - htShowPage() - -e02ddfSolve htPage == - m := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) - objValUnwrap htpLabelSpadValue(htPage, 'm) - nxest := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nxest) - objValUnwrap htpLabelSpadValue(htPage, 'nxest) - nyest := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nyest) - objValUnwrap htpLabelSpadValue(htPage, 'nyest) - u := nxest - 4 - v := nyest - 4 - wlist := [u,v] - w := APPLY ('MAX, wlist) - lwrk := (7*u*v + 25*w)*(w + 1) + 2*(u + v + 4*m) + 23*w + 56 - liwrk := m + 2*(nxest - 7)*(nyest - 7) - s := htpLabelInputString(htPage,'s) - initial := htpButtonValue(htPage,'start) - start := - initial = 'cold => '1 - '2 - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - (m = 30 and start = 1) => e02ddfDefaultSolve (htPage,nxest,nyest,lwrk,liwrk,s,ifail) - start = 1 => e02ddfColdSolve (htPage,m,nxest,nyest,lwrk,liwrk,s,ifail) - -- need to change as only wrk(1) is required - labelList := - "append"/[f(i) for i in 1..m] where f(i) == - prefix := ('"\newline \tab{2} ") - middle := ('"\tab{17} ") - post := ('"\tab{32} ") - end := ('"\tab{47} ") - xnam := INTERN STRCONC ('"x",STRINGIMAGE i) - ynam := INTERN STRCONC ('"y",STRINGIMAGE i) - fnam := INTERN STRCONC ('"f",STRINGIMAGE i) - wnam := INTERN STRCONC ('"w",STRINGIMAGE i) - [['text,:prefix],['bcStrings,[8, 0.0, xnam, 'F]], - ['text,:middle],['bcStrings,[8, 0.0, ynam, 'F]], - ['text,:post],['bcStrings,[8, 0.0, fnam, 'F]], - ['text,:end],['bcStrings,[8, 0.0, wnam, 'F]]] - lamdaList := - "append"/[g(i) for i in 1..nxest] where g(i) == - lnam := INTERN STRCONC ('"l",STRINGIMAGE i) - [['bcStrings,[8, 0.0, lnam, 'F]]] - prefix := ('"\blankline \menuitemstyle{} \tab{2} Values of Lamda: \newline") - lamdaList := [['text,:prefix],:lamdaList] - muList := - "append"/[h(i) for i in 1..nyest] where h(i) == - mnam := INTERN STRCONC ('"m",STRINGIMAGE i) - [['bcStrings,[8, 0.0, mnam, 'F]]] - prefix := ('"\blankline \menuitemstyle{} \tab{2} Values of Mu: \newline") - muList := [['text,:prefix],:muList] - prefix := ('"\blankline \menuitemstyle{} \tab{2} Value of nx: \newline \tab{2}") - nxList := [['text,:prefix],['bcStrings,[8, 10, 'nx, 'PI]]] - prefix := ('"\blankline \menuitemstyle{} \tab{2} Value of ny: \newline \tab{2}") - nyList := [['text,:prefix],['bcStrings,[8, 9, 'ny, 'PI]]] - prefix := ('"\blankline \menuitemstyle{} \tab{2} Value of WRK(1): \newline \tab{2}") - wList := [['text,:prefix],['bcStrings,[8, 0.0, 'wone, 'F]]] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :labelList,:lamdaList,:muList,:nxList,:nyList,:wList] - page := htInitPage('"E02DDF - Least-squares surface fit by bicubic splines with automatic knot placement, scattered data",nil) - htSay '"\menuitemstyle{}\tab{2} Values of \space{1} " - htSay '"\htbitmap{xr}: \tab{15} \menuitemstyle{}\tab{17} " - htSay '"Values of \space{1} \htbitmap{yr}: \tab{30}" - htSay '"\menuitemstyle{}\tab{32} Values of \space{1} " - htSay '"\htbitmap{fr}: \tab{45} \menuitemstyle{} " - htSay '"\tab{47} Values of \htbitmap{wr}:" - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'e02ddfWarmGen) - htpSetProperty(page,'m,m) - htpSetProperty(page,'nxest,nxest) - htpSetProperty(page,'nyest,nyest) - htpSetProperty(page,'lwrk,lwrk) - htpSetProperty(page,'liwrk,liwrk) - htpSetProperty(page,'s,s) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - - - -e02ddfColdSolve(htPage,m,nxest,nyest,lwrk,liwrk,s,ifail) == - labelList := - "append"/[f(i) for i in 1..m] where f(i) == - prefix := ('"\newline \tab{2} ") - middle := ('"\tab{17} ") - post := ('"\tab{32} ") - end := ('"\tab{47} ") - xnam := INTERN STRCONC ('"x",STRINGIMAGE i) - ynam := INTERN STRCONC ('"y",STRINGIMAGE i) - fnam := INTERN STRCONC ('"f",STRINGIMAGE i) - wnam := INTERN STRCONC ('"w",STRINGIMAGE i) - [['text,:prefix],['bcStrings,[8, 0.0, xnam, 'F]], - ['text,:middle],['bcStrings,[8, 0.0, ynam, 'F]], - ['text,:post],['bcStrings,[8, 0.0, fnam, 'F]], - ['text,:end],['bcStrings,[8, 0.0, wnam, 'F]]] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :labelList] - page := htInitPage('"E02DDF - Least-squares surface fit by bicubic splines with automatic knot placement, scattered data",nil) - htSay '"\menuitemstyle{}\tab{2} Values of \space{1} " - htSay '"\htbitmap{xr}: \tab{15} \menuitemstyle{}\tab{17} " - htSay '"Values of \space{1} \htbitmap{yr}: \tab{30}" - htSay '"\menuitemstyle{}\tab{32} Values of \space{1} " - htSay '"\htbitmap{fr}: \tab{44} \menuitemstyle{} " - htSay '"\tab{46} Values of \htbitmap{wr}:" - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'e02ddfColdGen) - htpSetProperty(page,'m,m) - htpSetProperty(page,'nxest,nxest) - htpSetProperty(page,'nyest,nyest) - htpSetProperty(page,'lwrk,lwrk) - htpSetProperty(page,'liwrk,liwrk) - htpSetProperty(page,'s,s) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -e02ddfDefaultSolve (htPage,nxest,nyest,lwrk,liwrk,s,ifail) == - m := 30 - page := htInitPage('"E02DDF - Least-squares surface fit by bicubic splines with automatic knot placement, scattered data",nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Values of \htbitmap{xr}:") - (text . "\tab{15} \menuitemstyle{} \tab{17} Values of ") - (text . "\htbitmap{yr}: \tab{30} \menuitemstyle{} \tab{32} ") - (text . "Values of \htbitmap{fr}: \tab{44} \menuitemstyle{} ") - (text . "\tab{46} Values of \htbitmap{wr}:") - (text . "\newline \tab{2} ") - (bcStrings (8 "11.16" x1 F)) - (text . "\tab{17}") - (bcStrings (8 "1.24" y1 F)) - (text . "\tab{32}") - (bcStrings (8 "22.15" f1 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w1 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "12.85" x2 F)) - (text . "\tab{17}") - (bcStrings (8 "3.06" y2 F)) - (text . "\tab{32}") - (bcStrings (8 "22.11" f2 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w2 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "19.85" x3 F)) - (text . "\tab{17}") - (bcStrings (8 "10.72" y3 F)) - (text . "\tab{32}") - (bcStrings (8 "7.97" f3 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w3 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "19.72" x4 F)) - (text . "\tab{17}") - (bcStrings (8 "1.39" y4 F)) - (text . "\tab{32}") - (bcStrings (8 "16.83" f4 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w4 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "15.91" x5 F)) - (text . "\tab{17}") - (bcStrings (8 "7.74" y5 F)) - (text . "\tab{32}") - (bcStrings (8 "15.30" f5 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w5 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "0" x6 F)) - (text . "\tab{17}") - (bcStrings (8 "20" y6 F)) - (text . "\tab{32}") - (bcStrings (8 "34.6" f6 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w6 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "20.87" x7 F)) - (text . "\tab{17}") - (bcStrings (8 "20" y7 F)) - (text . "\tab{32}") - (bcStrings (8 "5.74" f7 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w7 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "3.45" x8 F)) - (text . "\tab{17}") - (bcStrings (8 "12.78" y8 F)) - (text . "\tab{32}") - (bcStrings (8 "41.24" f8 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w8 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "14.26" x9 F)) - (text . "\tab{17}") - (bcStrings (8 "17.87" y9 F)) - (text . "\tab{32}") - (bcStrings (8 "10.74" f9 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w9 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "17.43" x10 F)) - (text . "\tab{17}") - (bcStrings (8 "3.46" y10 F)) - (text . "\tab{32}") - (bcStrings (8 "18.60" f10 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w10 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "22.8" x11 F)) - (text . "\tab{17}") - (bcStrings (8 "12.39" y11 F)) - (text . "\tab{32}") - (bcStrings (8 "5.47" f11 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w11 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "7.58" x12 F)) - (text . "\tab{17}") - (bcStrings (8 "1.98" y12 F)) - (text . "\tab{32}") - (bcStrings (8 "29.87" f12 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w12 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "25" x13 F)) - (text . "\tab{17}") - (bcStrings (8 "11.87" y13 F)) - (text . "\tab{32}") - (bcStrings (8 "4.4" f13 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w13 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "0" x14 F)) - (text . "\tab{17}") - (bcStrings (8 "0" y14 F)) - (text . "\tab{32}") - (bcStrings (8 "58.2" f14 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w14 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "9.66" x15 F)) - (text . "\tab{17}") - (bcStrings (8 "20" y15 F)) - (text . "\tab{32}") - (bcStrings (8 "4.73" f15 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w15 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "5.22" x16 F)) - (text . "\tab{17}") - (bcStrings (8 "14.66" y16 F)) - (text . "\tab{32}") - (bcStrings (8 "40.36" f16 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w16 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "17.25" x17 F)) - (text . "\tab{17}") - (bcStrings (8 "19.57" y17 F)) - (text . "\tab{32}") - (bcStrings (8 "6.43" f17 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w17 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "25" x18 F)) - (text . "\tab{17}") - (bcStrings (8 "3.87" y18 F)) - (text . "\tab{32}") - (bcStrings (8 "8.74" f18 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w18 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "12.13" x19 F)) - (text . "\tab{17}") - (bcStrings (8 "10.79" y19 F)) - (text . "\tab{32}") - (bcStrings (8 "13.71" f19 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w19 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "22.23" x20 F)) - (text . "\tab{17}") - (bcStrings (8 "6.21" y20 F)) - (text . "\tab{32}") - (bcStrings (8 "10.25" f20 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w20 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "11.52" x21 F)) - (text . "\tab{17}") - (bcStrings (8 "8.53" y21 F)) - (text . "\tab{32}") - (bcStrings (8 "15.74" f21 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w21 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "15.2" x22 F)) - (text . "\tab{17}") - (bcStrings (8 "0" y22 F)) - (text . "\tab{32}") - (bcStrings (8 "21.6" f22 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w22 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "7.54" x23 F)) - (text . "\tab{17}") - (bcStrings (8 "10.69" y23 F)) - (text . "\tab{32}") - (bcStrings (8 "19.31" f23 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w23 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "17.32" x24 F)) - (text . "\tab{17}") - (bcStrings (8 "13.78" y24 F)) - (text . "\tab{32}") - (bcStrings (8 "12.11" f24 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w24 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "2.14" x25 F)) - (text . "\tab{17}") - (bcStrings (8 "15.03" y25 F)) - (text . "\tab{32}") - (bcStrings (8 "53.1" f25 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w25 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "0.51" x26 F)) - (text . "\tab{17}") - (bcStrings (8 "8.37" y26 F)) - (text . "\tab{32}") - (bcStrings (8 "49.43" f26 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w26 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "22.69" x27 F)) - (text . "\tab{17}") - (bcStrings (8 "19.63" y27 F)) - (text . "\tab{32}") - (bcStrings (8 "3.25" f27 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w27 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "5.47" x28 F)) - (text . "\tab{17}") - (bcStrings (8 "17.13" y28 F)) - (text . "\tab{32}") - (bcStrings (8 "28.63" f28 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w28 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "21.67" x29 F)) - (text . "\tab{17}") - (bcStrings (8 "14.36" y29 F)) - (text . "\tab{32}") - (bcStrings (8 "5.52" f29 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w29 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "3.31" x30 F)) - (text . "\tab{17}") - (bcStrings (8 "0.33" y30 F)) - (text . "\tab{32}") - (bcStrings (8 "44.08" f30 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w30 F)) - (text . "\blankline")) - htMakeDoneButton('"Continue",'e02ddfColdGen) - htpSetProperty(page,'m,m) - htpSetProperty(page,'nxest,nxest) - htpSetProperty(page,'nyest,nyest) - htpSetProperty(page,'lwrk,lwrk) - htpSetProperty(page,'liwrk,liwrk) - htpSetProperty(page,'s,s) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -e02ddfColdGen htPage == - m := htpProperty(htPage,'m) - nxest := htpProperty(htPage,'nxest) - nyest := htpProperty(htPage,'nyest) - lwrk := htpProperty(htPage,'lwrk) - liwrk := htpProperty(htPage,'liwrk) - s := htpProperty(htPage,'s) - cold := '"c" - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - while y repeat - end := STRCONC ((first y).1," ") - y := rest y - right := STRCONC ((first y).1," ") - y := rest y - mid := STRCONC ((first y).1," ") - y := rest y - left := STRCONC ((first y).1," ") - y := rest y - xlist := [left,:xlist] - ylist := [mid,:ylist] - flist := [right,:flist] - wlist := [end,:wlist] - xstring := bcwords2liststring xlist - ystring := bcwords2liststring ylist - fstring := bcwords2liststring flist - wstring := bcwords2liststring wlist - -- additional entries nx,ny,lamda,mu,wrk needed to get it running - -- but they are just set to 0.0 - prefix := STRCONC('"e02ddf(_"",cold,"_",",STRINGIMAGE m,", [",xstring,"],[") - prefix := STRCONC(prefix,ystring,"],[",fstring,"],[",wstring,"], ") - prefix := STRCONC(prefix,STRINGIMAGE s,", ",STRINGIMAGE nxest,", ") - prefix := STRCONC(prefix,STRINGIMAGE nyest,", ",STRINGIMAGE lwrk,", ") - prefix := STRCONC(prefix,STRINGIMAGE liwrk,", 0,") - prefix := STRCONC(prefix,"new(1,", STRINGIMAGE nxest,",0.0)$MATRIX DFLOAT,0,") - prefix := STRCONC(prefix,"new(1,", STRINGIMAGE nyest,",0.0)$MATRIX DFLOAT,") - prefix := STRCONC(prefix,"new(1,", STRINGIMAGE lwrk,",0.0)$MATRIX DFLOAT,") --- prefix := STRCONC(prefix,"[[0.0 for i in 1..", STRINGIMAGE nxest,"]],0,") --- prefix := STRCONC(prefix,"[[0.0 for i in 1..", STRINGIMAGE nyest,"]],") --- prefix := STRCONC(prefix,"[[0.0 for i in 1..", STRINGIMAGE lwrk,"]],") - prefix := STRCONC(prefix,STRINGIMAGE ifail,")") - linkGen prefix - -e02ddfWarmGen htPage == - m := htpProperty(htPage,'m) - nxest := htpProperty(htPage,'nxest) - nyest := htpProperty(htPage,'nyest) - lwrk := htpProperty(htPage,'lwrk) - liwrk := htpProperty(htPage,'liwrk) - s := htpProperty(htPage,'s) - warm := '"w" - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - wrk := (first y).1 - y := rest y - for i in 1..lwrk repeat - wrkList := ['"0.0 ",:wrkList] - wrkList := [wrk,:wrkList] - wrkstring := bcwords2liststring wrkList - ny := STRCONC((first y).1," ") - y := rest y - nx := STRCONC((first y).1," ") - y := rest y - for i in 1..nyest repeat - mu := STRCONC ((first y).1, " ") - y := rest y - muList := [mu,:muList] - mustring := bcwords2liststring muList - for i in 1..nxest repeat - lam := STRCONC ((first y).1, " ") - y := rest y - lamList := [lam,:lamList] - lamstring := bcwords2liststring lamList - while y repeat - end := STRCONC ((first y).1," ") - y := rest y - right := STRCONC ((first y).1," ") - y := rest y - mid := STRCONC ((first y).1," ") - y := rest y - left := STRCONC ((first y).1," ") - y := rest y - xlist := [left,:xlist] - ylist := [mid,:ylist] - flist := [right,:flist] - wlist := [end,:wlist] - xstring := bcwords2liststring xlist - ystring := bcwords2liststring ylist - fstring := bcwords2liststring flist - wstring := bcwords2liststring wlist - -- additional entries nx,ny,lamda,mu,wrk needed to get it running - -- but they are just set to 0.0 - prefix := STRCONC('"e02ddf(_"",warm,"_",",STRINGIMAGE m,", [",xstring,"],[") - prefix := STRCONC(prefix,ystring,"],[",fstring,"],[",wstring,"], ") - prefix := STRCONC(prefix,STRINGIMAGE s,", ",STRINGIMAGE nxest,", ") - prefix := STRCONC(prefix,STRINGIMAGE nyest,", ",STRINGIMAGE lwrk,", ") - prefix := STRCONC(prefix,STRINGIMAGE liwrk,", ",nx,",[",lamstring,"],",ny) - prefix := STRCONC(prefix,",[",mustring,"],[",wrkstring,"],") - prefix := STRCONC(prefix,STRINGIMAGE ifail,")") - linkGen prefix - -e02zaf() == - htInitPage('"E02ZAF - Sort 2-D sata into panels for fitting bicubic splines",nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXe02zaf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02zaf| '|NagFittingPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "Sorts the set of points {\em (\htbitmap{xr},") - (text . "\htbitmap{yr})} into panels defined by \space{1}") - (text . "\htbitmap{px} -8 points \htbitmap{lamdai} ") - (text . "on the x-axis and \space{1}\htbitmap{py}-8 points ") - (text . "\htbitmap{muj} on the y axis. The points are ordered ") - (text . "so that all points in a panel occur before data in succeeding ") - (text . "panels. Within a panel, the points maintain their original ") - (text . "order. ") - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} \newline ") - (text . "Number of points to be sorted to be sorted {\it m}: ") - (text . "\newline\tab{2} ") - (bcStrings (6 10 m PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "\newline Intercepts + 8 on x axis {\em px}:") - (text . "\tab{32} \menuitemstyle{}\tab{34}") - (text . "Intercepts + 8 on y axis {\em py}:") - (text . "\newline\tab{2} ") - (bcStrings (6 9 px PI)) - (text . "\tab{34} ") - (bcStrings (6 10 py PI)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} \newline ") - (text . "Dimension of point {\it npoint}: ") - (text . "\newline\tab{2} ") - (bcStrings (6 45 npoint PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'e02zafSolve) - htShowPage() - -e02zafSolve htPage == - m := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) - objValUnwrap htpLabelSpadValue(htPage, 'm) - px := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'px) - objValUnwrap htpLabelSpadValue(htPage, 'px) - py := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'py) - objValUnwrap htpLabelSpadValue(htPage, 'py) - npoint := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'npoint) - objValUnwrap htpLabelSpadValue(htPage, 'npoint) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - ((m = '10 and px = '9) and py = '10) => e02zafDefaultSolve(htPage,npoint,ifail) - labelList := - "append"/[fxy(i) for i in 1..m] where fxy(i) == - prefix := ('"\newline \tab{2} ") - middle := ('"\tab{32} ") - lnam := INTERN STRCONC ('"x",STRINGIMAGE i) - cnam := INTERN STRCONC ('"y",STRINGIMAGE i) - [['text,:prefix],['bcStrings,[8, 0.0, lnam, 'F]], - ['text,:middle],['bcStrings,[8, 0.0, cnam, 'F]]] - lamList := - "append"/[flam(i) for i in 5..(px-4)] where flam(i) == - lnam := INTERN STRCONC ('"l",STRINGIMAGE i) - [['bcStrings,[8, 0.0, lnam, 'F]]] - prefix := ('"\blankline \menuitemstyle{} \tab{2} {\it \lambda(5) to ") - prefix := STRCONC(prefix,"\lambda(px-4)}: \newline \tab{2} ") - lamList := [['text,:prefix],:lamList] - muList := - "append"/[fmu(i) for i in 5..(py-4)] where fmu(i) == - mnam := INTERN STRCONC ('"m",STRINGIMAGE i) - [['bcStrings,[8, 0.0, mnam, 'F]]] - prefix := ('"\blankline \menuitemstyle{} \tab{2} {\it \mu(5) to \mu(py-4)}: ") - prefix := STRCONC(prefix,"\newline \tab{2} ") - muList := [['text,:prefix],:muList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :labelList,:lamList,:muList] - page := htInitPage('"E02ZAF - Sort 2-D sata into panels for fitting bicubic splines",nil) - htSay '"\menuitemstyle{}\tab{2} {\it x(m)}: " - htSay '"\tab{30} \menuitemstyle{}\tab{32} {\it y(m)}: " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'e02zafGen) - htpSetProperty(page,'m,m) - htpSetProperty(page,'px,px) - htpSetProperty(page,'py,py) - htpSetProperty(page,'npoint,npoint) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -e02zafDefaultSolve (htPage,npoint,ifail) == - m := '10 - px := '9 - py := '10 - page := htInitPage('"E02ZAF - Sort 2-D sata into panels for fitting bicubic splines",nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} {\it x(m)}:") - (text . "\tab{30} \menuitemstyle{} \tab{32} {\it y(m)}:") - (text . "\newline \tab{2} ") - (bcStrings (8 "0.00" x1 F)) - (text . "\tab{32}") - (bcStrings (8 "0.77" y1 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "0.70" x2 F)) - (text . "\tab{32}") - (bcStrings (8 "1.06" y2 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "1.44" x3 F)) - (text . "\tab{32}") - (bcStrings (8 "0.33" y3 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "0.21" x4 F)) - (text . "\tab{32}") - (bcStrings (8 "0.44" y4 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "1.01" x5 F)) - (text . "\tab{32}") - (bcStrings (8 "0.50" y5 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "1.84" x6 F)) - (text . "\tab{32}") - (bcStrings (8 "0.02" y6 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "0.71" x7 F)) - (text . "\tab{32}") - (bcStrings (8 "1.95" y7 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "1.00" x8 F)) - (text . "\tab{32}") - (bcStrings (8 "1.20" y8 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "0.54" x9 F)) - (text . "\tab{32}") - (bcStrings (8 "0.04" y9 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "1.531" x10 F)) - (text . "\tab{32}") - (bcStrings (8 "0.18" y10 F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} {\it \lambda(5) to \lambda(px-4)}:") - (text . "\newline \tab{2}") - (bcStrings (8 "1.00" l5 F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} {\it \mu(5) to \mu(py-4)}:") - (text . "\newline \tab{2}") - (bcStrings (8 "0.80" mu5 F)) - (bcStrings (8 "1.20" mu6 F)) - (text . "\blankline ")) - htMakeDoneButton('"Continue",'e02zafGen) - htpSetProperty(page,'m,m) - htpSetProperty(page,'px,px) - htpSetProperty(page,'py,py) - htpSetProperty(page,'npoint,npoint) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -e02zafGen htPage == - m := htpProperty(htPage,'m) - px := htpProperty(htPage,'px) - py := htpProperty(htPage,'py) - npoint := htpProperty(htPage,'npoint) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - nadres := (px-7)*(py-7) - -- mu - for i in 1..4 repeat - muList := ['"0 ",:muList] - for i in 5..(py-4) repeat - right := STRCONC ((first y).1," ") - y := rest y - muList := [right,:muList] - for i in (py-3)..py repeat - muList := ['"0 ",:muList] - mustring := bcwords2liststring muList - -- lamda - for i in 1..4 repeat - lamList := ['"0 ",:lamList] - for i in 5..(px-4) repeat - right := STRCONC ((first y).1," ") - y := rest y - lamList := [right,:lamList] - for i in (px-3)..px repeat - lamList := ['"0 ",:lamList] - lamstring := bcwords2liststring lamList - -- x & y - while y repeat - right := STRCONC ((first y).1," ") - y := rest y - left := STRCONC ((first y).1," ") - y := rest y - xlist := [left,:xlist] - ylist := [right,:ylist] - xstring := bcwords2liststring xlist - ystring := bcwords2liststring ylist - prefix := STRCONC('"e02zaf(",STRINGIMAGE px,", ",STRINGIMAGE py,",[") - prefix := STRCONC(prefix,lamstring,"],[",mustring,"], ",STRINGIMAGE m,", [") - prefix := STRCONC(prefix,xstring,"],[",ystring,"], ",STRINGIMAGE npoint,", ") - prefix := STRCONC(prefix,STRINGIMAGE nadres,", ",STRINGIMAGE ifail,")") - linkGen prefix - - - -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/nag-e02b.boot b/src/interp/nag-e02b.boot new file mode 100644 index 00000000..aa307b1b --- /dev/null +++ b/src/interp/nag-e02b.boot @@ -0,0 +1,1737 @@ +-- 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. + + +)package "BOOT" + +-- READ THIS NOW! +-- +-- The automatic make fails to compile this file properly, leaving a +-- truncated clisp file in int/interp. So if you change this file it +-- must be compiled by hand in the interpreter (which works fine). +-- MCD. +-- + +e02daf() == + htInitPage('"E02DAF - Least-squares surface fit, bicubic splines",nil) + htMakePage '( + (domainConditions + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXe02daf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02daf| '|NagFittingPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "Determines a minimal, least squares bicubic B-spline surface fit") + (text . "\htbitmap{e02daf} to the set of points ") + (text . "{\em (\htbitmap{xr},\htbitmap{yr},\htbitmap{fr})} with weights ") + (text . "\htbitmap{wr}, for r = 1,2,...,m. The user must supply internal ") + (text . "knot sets {\lambda},in the x-direction and {\mu} in the ") + (text . "y-direction, ") + (text . "which can be thought of as dividing the data region into panels;") + (text . "s(x,y) consists of a seperate bicubic polynomial in each panel, ") + (text . "the polynomial joining together with second derivative ") + (text . "continuity. Eight additional (external) knots are added to each ") + (text . "of the knot sets by this routine. The routine minimizes \Sigma, ") + (text . "the sum of squares of the weighted residuals ") + (text . "\htbitmap{e02daf1}, for r = 1,2,...,m, subject to the ") + (text . "given knot sets. \newline ") + (text . "A call of this routine should be preceded by a call of E02ZAF ") + (text . "to provide indexing information. ") + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} \newline ") + (text . "Number of data points {\it m}: ") + (text . "\newline\tab{2} ") + (bcStrings (6 30 m PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "\newline Knots in x direction {\em px}") + (text . "\htbitmap{great=} 8: \tab{32} \menuitemstyle{}\tab{34}") + (text . "Knots in y direction {\em py}:") + (text . "\newline\tab{2} ") + (bcStrings (6 8 px PI)) + (text . "\tab{34} ") + (bcStrings (6 10 py PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "\newline Rank threshold {\em eps}:") + (text . "\newline\tab{2} ") + (bcStrings (10 "0.000001" eps F)) + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} \newline ") + (text . "Dimension of point {\it npoint}: ") + (text . "\newline\tab{2} ") + (bcStrings (6 43 npoint PI)) + -- include a radio button later to allow switching of + -- x & y if px <= py + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Ifail value: ") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'e02dafSolve) + htShowPage() + +e02dafSolve htPage == + m := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) + objValUnwrap htpLabelSpadValue(htPage, 'm) + px := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'px) + objValUnwrap htpLabelSpadValue(htPage, 'px) + py := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'py) + objValUnwrap htpLabelSpadValue(htPage, 'py) + npoint := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'npoint) + objValUnwrap htpLabelSpadValue(htPage, 'npoint) + nc := (px - 4)*(py - 4) + nws := (2*nc + 1)*(3*py - 6) -2 + eps := htpLabelInputString(htPage,'eps) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + ((m = '30 and px = '8) and py = '10) => e02dafDefaultSolve(htPage,eps,nws,npoint,ifail) + labelList := + "append"/[fxy(i) for i in 1..m] where fxy(i) == + prefix := ('"\newline \tab{2} ") + middle := ('"\tab{17} ") + next := ('"\tab{32} ") + end := ('"\tab{47} ") + xnam := INTERN STRCONC ('"x",STRINGIMAGE i) + ynam := INTERN STRCONC ('"y",STRINGIMAGE i) + fnam := INTERN STRCONC ('"f",STRINGIMAGE i) + wnam := INTERN STRCONC ('"w",STRINGIMAGE i) + [['text,:prefix],['bcStrings,[8, 0.0, xnam, 'F]], + ['text,:middle],['bcStrings,[8, 0.0, ynam, 'F]], + ['text,:next],['bcStrings,[8, 0.0, fnam, 'F]], + ['text,:end],['bcStrings,[8, 0.0, wnam, 'F]]] + lamList := + "append"/[flam(i) for i in 5..(px-4)] where flam(i) == + lnam := INTERN STRCONC ('"l",STRINGIMAGE i) + [['bcStrings,[8, 0.0, lnam, 'F]]] + prefix := ('"\blankline \menuitemstyle{} \tab{2} lamda(5) to lamda(px-4): ") + prefix := STRCONC(prefix,"\newline \tab{2} ") + postfix := ('"\newline \blankline ") + lamList := [['text,:prefix],:lamList,['text,:postfix]] + muList := + "append"/[fmu(i) for i in 5..(py-4)] where fmu(i) == + mnam := INTERN STRCONC ('"m",STRINGIMAGE i) + [['bcStrings,[8, 0.0, mnam, 'F]]] + prefix := ('"\menuitemstyle{} \tab{2} mu(5) to mu(py-4):") + prefix := STRCONC(prefix,"\newline \tab{2} ") + muList := [['text,:prefix],:muList] + pList := + "append"/[fp(i) for i in 1..npoint] where fp(i) == + prefix := ('"\newline \tab{2} ") + pnam := INTERN STRCONC ('"p",STRINGIMAGE i) + [['text,:prefix],['bcStrings,[8, 0.0, pnam, 'F]]] + prefix := ('"\blankline \menuitemstyle{} \tab{2} Enter values of Point: ") + pList := [['text,:prefix],:pList] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :labelList,:lamList,:muList,:pList] + page := htInitPage('"E02DAF - Least-squares surface fit, bicubic splines",nil) + htSay '"\menuitemstyle{}\tab{2} Values of \htbitmap{xr}: " + htSay '"\tab{15} \menuitemstyle{}\tab{17} Values of \htbitmap{yr}:" + htSay '"\tab{30} \menuitemstyle{}\tab{32} Values of \htbitmap{fr}:" + htSay '"\tab{44} \menuitemstyle{}\tab{46} Values of \htbitmap{wr}:" + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'e02dafGen) + htpSetProperty(page,'m,m) + htpSetProperty(page,'px,px) + htpSetProperty(page,'py,py) + htpSetProperty(page,'nws,nws) + htpSetProperty(page,'eps,eps) + htpSetProperty(page,'npoint,npoint) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +e02dafDefaultSolve (htPage,eps,nws,npoint,ifail) == + m := '30 + px := '8 + py := '10 + page := htInitPage('"E02DAF - Least-squares surface fit, bicubic splines",nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Values of \htbitmap{xr}:") + (text . "\tab{15} \menuitemstyle{} \tab{17} Values of ") + (text . "\htbitmap{yr}: \tab{30} \menuitemstyle{} \tab{32} ") + (text . "Values of \htbitmap{fr}: \tab{44} \menuitemstyle{} ") + (text . "\tab{46} Values of \htbitmap{wr}:") + (text . "\newline \tab{2} ") + (bcStrings (8 "-0.52" x1 F)) + (text . "\tab{17}") + (bcStrings (8 "0.60" y1 F)) + (text . "\tab{32}") + (bcStrings (8 "0.93" f1 F)) + (text . "\tab{47}") + (bcStrings (8 "10" w1 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "-0.61" x2 F)) + (text . "\tab{17}") + (bcStrings (8 "-0.95" y2 F)) + (text . "\tab{32}") + (bcStrings (8 "-1.79" f2 F)) + (text . "\tab{47}") + (bcStrings (8 "10" w2 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "0.93" x3 F)) + (text . "\tab{17}") + (bcStrings (8 "0.87" y3 F)) + (text . "\tab{32}") + (bcStrings (8 "0.36" f3 F)) + (text . "\tab{47}") + (bcStrings (8 "10" w3 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "0.09" x4 F)) + (text . "\tab{17}") + (bcStrings (8 "0.84" y4 F)) + (text . "\tab{32}") + (bcStrings (8 "0.52" f4 F)) + (text . "\tab{47}") + (bcStrings (8 "10" w4 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "0.88" x5 F)) + (text . "\tab{17}") + (bcStrings (8 "0.17" y5 F)) + (text . "\tab{32}") + (bcStrings (8 "0.49" f5 F)) + (text . "\tab{47}") + (bcStrings (8 "10" w5 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "-0.70" x6 F)) + (text . "\tab{17}") + (bcStrings (8 "-0.87" y6 F)) + (text . "\tab{32}") + (bcStrings (8 "-1.76" f6 F)) + (text . "\tab{47}") + (bcStrings (8 "10" w6 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "1" x7 F)) + (text . "\tab{17}") + (bcStrings (8 "1" y7 F)) + (text . "\tab{32}") + (bcStrings (8 "0.33" f7 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w7 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "1" x8 F)) + (text . "\tab{17}") + (bcStrings (8 "0.1" y8 F)) + (text . "\tab{32}") + (bcStrings (8 "0.48" f8 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w8 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "0.3" x9 F)) + (text . "\tab{17}") + (bcStrings (8 "0.24" y9 F)) + (text . "\tab{32}") + (bcStrings (8 "0.65" f9 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w9 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "-0.77" x10 F)) + (text . "\tab{17}") + (bcStrings (8 "-0.77" y10 F)) + (text . "\tab{32}") + (bcStrings (8 "-1.82" f10 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w10 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "-0.23" x11 F)) + (text . "\tab{17}") + (bcStrings (8 "0.32" y11 F)) + (text . "\tab{32}") + (bcStrings (8 "0.92" f11 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w11 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "-1" x12 F)) + (text . "\tab{17}") + (bcStrings (8 "1" y12 F)) + (text . "\tab{32}") + (bcStrings (8 "1" f12 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w12 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "-0.26" x13 F)) + (text . "\tab{17}") + (bcStrings (8 "-0.63" y13 F)) + (text . "\tab{32}") + (bcStrings (8 "8.88" f13 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w13 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "-0.83" x14 F)) + (text . "\tab{17}") + (bcStrings (8 "-0.66" y14 F)) + (text . "\tab{32}") + (bcStrings (8 "-2.01" f14 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w14 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "0.22" x15 F)) + (text . "\tab{17}") + (bcStrings (8 "0.93" y15 F)) + (text . "\tab{32}") + (bcStrings (8 "0.47" f15 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w15 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "0.89" x16 F)) + (text . "\tab{17}") + (bcStrings (8 "0.15" y16 F)) + (text . "\tab{32}") + (bcStrings (8 "0.49" f16 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w16 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "-0.80" x17 F)) + (text . "\tab{17}") + (bcStrings (8 "0.99" y17 F)) + (text . "\tab{32}") + (bcStrings (8 "0.84" f17 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w17 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "-0.88" x18 F)) + (text . "\tab{17}") + (bcStrings (8 "-0.54" y18 F)) + (text . "\tab{32}") + (bcStrings (8 "-2.42" f18 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w18 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "0.68" x19 F)) + (text . "\tab{17}") + (bcStrings (8 "0.44" y19 F)) + (text . "\tab{32}") + (bcStrings (8 "0.47" f19 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w19 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "-0.14" x20 F)) + (text . "\tab{17}") + (bcStrings (8 "-0.72" y20 F)) + (text . "\tab{32}") + (bcStrings (8 "7.15" f20 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w20 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "0.67" x21 F)) + (text . "\tab{17}") + (bcStrings (8 "0.63" y21 F)) + (text . "\tab{32}") + (bcStrings (8 "0.44" f21 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w21 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "-0.90" x22 F)) + (text . "\tab{17}") + (bcStrings (8 "-0.40" y22 F)) + (text . "\tab{32}") + (bcStrings (8 "-3.34" f22 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w22 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "-0.84" x23 F)) + (text . "\tab{17}") + (bcStrings (8 "0.20" y23 F)) + (text . "\tab{32}") + (bcStrings (8 "2.78" f23 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w23 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "0.84" x24 F)) + (text . "\tab{17}") + (bcStrings (8 "0.43" y24 F)) + (text . "\tab{32}") + (bcStrings (8 "0.44" f24 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w24 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "0.15" x25 F)) + (text . "\tab{17}") + (bcStrings (8 "0.28" y25 F)) + (text . "\tab{32}") + (bcStrings (8 "0.70" f25 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w25 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "-0.91" x26 F)) + (text . "\tab{17}") + (bcStrings (8 "-0.24" y26 F)) + (text . "\tab{32}") + (bcStrings (8 "-6.52" f26 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w26 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "-0.35" x27 F)) + (text . "\tab{17}") + (bcStrings (8 "0.86" y27 F)) + (text . "\tab{32}") + (bcStrings (8 "0.66" f27 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w27 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "-0.16" x28 F)) + (text . "\tab{17}") + (bcStrings (8 "-0.41" y28 F)) + (text . "\tab{32}") + (bcStrings (8 "2.32" f28 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w28 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "-0.35" x29 F)) + (text . "\tab{17}") + (bcStrings (8 "-0.05" y29 F)) + (text . "\tab{32}") + (bcStrings (8 "1.66" f29 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w29 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "-1" x30 F)) + (text . "\tab{17}") + (bcStrings (8 "-1" y30 F)) + (text . "\tab{32}") + (bcStrings (8 "-1" f30 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w30 F)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2} mu(5) to mu(py-4):") + (text . "\newline \tab{2}") + (bcStrings (8 "-0.50" mu5 F)) + (bcStrings (8 "0.00" mu6 F)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2} Enter values for point:") + (text . "\newline \tab{2}") + (bcStrings (6 3 p1 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 6 p2 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 4 p3 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 5 p4 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 7 p5 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 10 p6 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 8 p7 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 9 p8 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 11 p9 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 13 p10 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 12 p11 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 15 p12 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 14 p13 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 18 p14 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 16 p15 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 17 p16 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 19 p17 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 20 p18 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 21 p19 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 30 p20 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 23 p21 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 26 p22 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 24 p23 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 25 p24 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 27 p25 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 28 p26 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 0 p27 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 29 p28 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 0 p29 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 0 p30 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 2 p31 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 22 p32 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 1 p33 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 0 p34 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 0 p35 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 0 p36 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 0 p37 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 0 p38 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 0 p39 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 0 p40 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 0 p41 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 0 p42 PI)) + (text . "\newline \tab{2}") + (bcStrings (6 0 p43 PI)) + (text . "\blankline")) + htMakeDoneButton('"Continue",'e02dafGen) + htpSetProperty(page,'m,m) + htpSetProperty(page,'px,px) + htpSetProperty(page,'py,py) + htpSetProperty(page,'nws,nws) + htpSetProperty(page,'eps,eps) + htpSetProperty(page,'npoint,npoint) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +e02dafGen htPage == + m := htpProperty(htPage,'m) + px := htpProperty(htPage,'px) + py := htpProperty(htPage,'py) + nws := htpProperty(htPage,'nws) + eps := htpProperty(htPage,'eps) + npoint := htpProperty(htPage,'npoint) + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + nadres := (px-7)*(py-7) + -- point + for i in 1..npoint repeat + right := STRCONC ((first y).1," ") + y := rest y + pointList := [right,:pointList] + pstring := bcwords2liststring pointList + -- mu + for i in 1..4 repeat + muList := ['"0 ",:muList] + for i in 5..(py-4) repeat + right := STRCONC ((first y).1," ") + y := rest y + muList := [right,:muList] + for i in (py-3)..py repeat + muList := ['"0 ",:muList] + mustring := bcwords2liststring muList + -- lamda + for i in 1..4 repeat + lamList := ['"0 ",:lamList] + for i in 5..(px-4) repeat + right := STRCONC ((first y).1," ") + y := rest y + lamList := [right,:lamList] + for i in (px-3)..px repeat + lamList := ['"0 ",:lamList] + lamstring := bcwords2liststring lamList + -- x & y + while y repeat + one := STRCONC((first y).1," ") + y := rest y + two := STRCONC((first y).1," ") + y := rest y + three := STRCONC ((first y).1," ") + y := rest y + four := STRCONC ((first y).1," ") + y := rest y + xlist := [four,:xlist] + ylist := [three,:ylist] + flist := [two,:flist] + wlist := [one,:wlist] + xstring := bcwords2liststring xlist + ystring := bcwords2liststring ylist + fstring := bcwords2liststring flist + wstring := bcwords2liststring wlist + nc := (px-4)*(py-4) + prefix := STRCONC('"e02daf(",STRINGIMAGE m,", ",STRINGIMAGE px,", ") + prefix := STRCONC(prefix,STRINGIMAGE py,",[",xstring,"],[",ystring,"],[") + prefix := STRCONC(prefix,fstring,"],[",wstring,"],[",mustring,"],[") + prefix := STRCONC(prefix,pstring,"], ",STRINGIMAGE npoint,", ") + prefix := STRCONC(prefix,STRINGIMAGE nc,", ",STRINGIMAGE nws,", ",eps,", [") + prefix := STRCONC(prefix,lamstring,"], ",STRINGIMAGE ifail,")") + linkGen prefix + + +e02dcf() == + htInitPage('"E02DCF - Least-squares curve by bicubic splines with automatic knot placement, data on a rectangular grid",nil) + htMakePage '( + (domainConditions + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXe02dcf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02dcf| '|NagFittingPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\newline ") + (text . "Determines a bicubic spline approximation to a set of points ") + (text . "given on a rectangular grid defined by \htbitmap{mx} ") + (text . "points \htbitmap{xq} on the x-axis and ") + (text . "\htbitmap{my} points \htbitmap{yr} on the ") + (text . "y-axix. The knots \htbitmap{lamdai}, for i = 1,2,...,") + (text . "\htbitmap{nx} and \htbitmap{mui}, for ") + (text . "i = 1,2,...,\htbitmap{ny} are chosen for this routine ") + (text . ", but a single parameter S must be specified to control the ") + (text . "trade-off between closeness of fit and smoothness of fit. This ") + (text . "affects the number of knots required by the spline, which is ") + (text . "given in the B-spline representation \htbitmap{e02daf}") + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} \newline ") + (text . "Grid points on x-axis \htbitmap{mx}: ") + (text . "\tab{30} \menuitemstyle{}\tab{32} Grid points on y-axis ") + (text . "\htbitmap{my}: ") + (text . "\newline\tab{2} ") + (bcStrings (6 11 mx PI)) + (text . "\tab{32} ") + (bcStrings (6 9 my PI)) + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} ") + (text . "Over-estimate of \htbitmap{nx} of knots \lambda of the ") + (text . "computed spline, {\it nxest}: \newline\tab{2} ") + (bcStrings (6 15 nxest PI)) + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} ") + (text . "Over-estimate of \htbitmap{ny} of knots \mu of the computed ") + (text . "spline, {\it nyest}: \newline\tab{2} ") + (bcStrings (6 13 nyest PI)) + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} \newline ") + (text . "Smoothing factor {\it s}: ") + (text . "\newline\tab{2} ") + (bcStrings (6 "0.1" s F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Start value: ") + (radioButtons start + ("" " Cold Start - no values needed for {\it nx,ny,lamda,mu} or {\it iwrk}" cold) + ("" " Warm Start - uses knots found in a previous call" warm)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Ifail value: ") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'e02dcfSolve) + htShowPage() + +e02dcfSolve htPage == + mx := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'mx) + objValUnwrap htpLabelSpadValue(htPage, 'mx) + my := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'my) + objValUnwrap htpLabelSpadValue(htPage, 'my) + nxest := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nxest) + objValUnwrap htpLabelSpadValue(htPage, 'nxest) + nyest := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nyest) + objValUnwrap htpLabelSpadValue(htPage, 'nyest) + wrklist := [my,nxest] + wrkmax := APPLY ('MAX, wrklist) + lwrk := 4*(mx + my) +11*(nxest + nyest) + nxest*my + wrkmax +54 + liwrk := 3 + mx + my + nxest + nyest + s := htpLabelInputString(htPage,'s) + initial := htpButtonValue(htPage,'start) + start := + initial = 'cold => '1 + '2 + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + ((mx = 11 and my = 9) and start = 1) => + e02dcfDefaultSolve (htPage,nxest,nyest,lwrk,liwrk,s,ifail) + start = 1 => e02dcfColdSolve (htPage,mx,my,nxest,nyest,lwrk,liwrk,s,ifail) + -- warm start not really possible from hyperdoc + -- as inputing a workspace array of dimension 592 is asking too much + -- user should use the command line, using the previous calculated + -- parameters + htInitPage('"E02DCF - Least-squares curve by bicubic splines with automatic knot placement, data on a rectangular grid",nil) + htMakePage '( + (domainConditions + (isDomain PI (PositiveInteger))) + (text . "\blankline ") + (text . "{\center{\em Hyperdoc interface not available for warm starts.}}") + (text . "\newline ") + (text . "{\center{\em Please use the command line.}}")) + htMakeDoneButton('"Continue",'e02dcf) + htShowPage() + + + +e02dcfColdSolve(htPage,mx,my,nxest,nyest,lwrk,liwrk,s,ifail) == + xList := + "append"/[f(i) for i in 1..mx] where f(i) == + xnam := INTERN STRCONC ('"x",STRINGIMAGE i) + [['bcStrings,[8, 0.0, xnam, 'F]]] + yList := + "append"/[g(i) for i in 1..my] where g(i) == + ynam := INTERN STRCONC ('"g",STRINGIMAGE i) + [['bcStrings,[8, 0.0, ynam, 'F]]] + prefix:= ('"\blankline \menuitemstyle{}\tab{2} Values of {\it y(my)}: \newline ") + yList := [['text,:prefix],:yList] + fList := + "append"/[h(i) for i in 1..(mx*my)] where h(i) == + fnam := INTERN STRCONC ('"g",STRINGIMAGE i) + [['bcStrings,[8, 0.0, fnam, 'F]]] + prefix:=('"\blankline \menuitemstyle{} \tab{2} Values of {\it f(mx*my)}: \newline ") + fList := [['text,:prefix],:fList] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :xList,:yList,:fList] + page := htInitPage('"E02DCF - Least-squares curve by bicubic splines with automatic knot placement, data on a rectangular grid",nil) + htSay '"\menuitemstyle{}\tab{2} Values of {\it x(mx)}: \newline " + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'e02dcfColdGen) + htpSetProperty(page,'mx,mx) + htpSetProperty(page,'my,my) + htpSetProperty(page,'nxest,nxest) + htpSetProperty(page,'nyest,nyest) + htpSetProperty(page,'lwrk,lwrk) + htpSetProperty(page,'liwrk,liwrk) + htpSetProperty(page,'s,s) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +e02dcfDefaultSolve (htPage,nxest,nyest,lwrk,liwrk,s,ifail) == + mx := 11 + my := 9 + page := htInitPage('"E02DCF - Least-squares curve by bicubic splines with automatic knot placement, data on a rectangular grid",nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Values of {\it x(mx)}:") + (text . "\newline ") + (bcStrings (8 "0" x1 F)) + (bcStrings (8 "0.5" x2 F)) + (bcStrings (8 "1" x3 F)) + (bcStrings (8 "1.5" x4 F)) + (bcStrings (8 "2" x5 F)) + (bcStrings (8 "2.5" x6 F)) + (bcStrings (8 "3" x7 F)) + (bcStrings (8 "3.5" x8 F)) + (bcStrings (8 "4" x9 F)) + (bcStrings (8 "4.5" x10 F)) + (bcStrings (8 "5" x11 F)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2} Values of {\it y(my)}:") + (text . "\newline ") + (bcStrings (8 "0" y1 F)) + (bcStrings (8 "0.5" y2 F)) + (bcStrings (8 "1" y3 F)) + (bcStrings (8 "1.5" y4 F)) + (bcStrings (8 "2" y5 F)) + (bcStrings (8 "2.5" y6 F)) + (bcStrings (8 "3" y7 F)) + (bcStrings (8 "3.5" y8 F)) + (bcStrings (8 "4" y9 F)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2} Values of {\it f(mx*my)}:") + (text . "\newline ") + (bcStrings (8 "1" f1 F)) + (bcStrings (8 "0.88758" f2 F)) + (bcStrings (8 "0.5403" f3 F)) + (bcStrings (8 "0.070737" f4 F)) + (bcStrings (8 "-0.41515" f5 F)) + (bcStrings (8 "-0.80114" f6 F)) + (bcStrings (8 "-0.97999" f7 F)) + (bcStrings (8 "-0.93446" f8 F)) + (bcStrings (8 "-0.65664" f9 F)) + (bcStrings (8 "1.5" f10 F)) + (bcStrings (8 "1.3564" f11 F)) + (bcStrings (8 "0.82045" f12 F)) + (bcStrings (8 "0.10611" f13 F)) + (bcStrings (8 "-0.62422" f14 F)) + (bcStrings (8 "-1.2317" f15 F)) + (bcStrings (8 "-1.485" f16 F)) + (bcStrings (8 "-1.3047" f17 F)) + (bcStrings (8 "-0.98547" f18 F)) + (bcStrings (8 "2.06" f19 F)) + (bcStrings (8 "1.7552" f20 F)) + (bcStrings (8 "1.0806" f21 F)) + (bcStrings (8 "0.15147" f22 F)) + (bcStrings (8 "-0.83229" f23 F)) + (bcStrings (8 "-1.6023" f24 F)) + (bcStrings (8 "-1.97" f25 F)) + (bcStrings (8 "-1.8729" f26 F)) + (bcStrings (8 "-1.4073" f27 F)) + (bcStrings (8 "2.57" f28 F)) + (bcStrings (8 "2.124" f29 F)) + (bcStrings (8 "1.3508" f30 F)) + (bcStrings (8 "0.17684" f31 F)) + (bcStrings (8 "-1.0404" f32 F)) + (bcStrings (8 "-2.0029" f33 F)) + (bcStrings (8 "-2.475" f34 F)) + (bcStrings (8 "-2.3511" f35 F)) + (bcStrings (8 "-1.6741" f36 F)) + (bcStrings (8 "3" f37 F)) + (bcStrings (8 "2.6427" f38 F)) + (bcStrings (8 "1.6309" f39 F)) + (bcStrings (8 "0.21221" f40 F)) + (bcStrings (8 "-1.2484" f41 F)) + (bcStrings (8 "-2.2034" f42 F)) + (bcStrings (8 "-2.97" f43 F)) + (bcStrings (8 "-2.8094" f44 F)) + (bcStrings (8 "-1.9809" f45 F)) + (bcStrings (8 "3.5" f46 F)) + (bcStrings (8 "3.1715" f47 F)) + (bcStrings (8 "1.8611" f48 F)) + (bcStrings (8 "0.24458" f49 F)) + (bcStrings (8 "-1.4565" f50 F)) + (bcStrings (8 "-2.864" f51 F)) + (bcStrings (8 "-3.265" f52 F)) + (bcStrings (8 "-3.2776" f53 F)) + (bcStrings (8 "-2.2878" f54 F)) + (bcStrings (8 "4.04" f55 F)) + (bcStrings (8 "3.5103" f56 F)) + (bcStrings (8 "2.0612" f57 F)) + (bcStrings (8 "0.28595" f58 F)) + (bcStrings (8 "-1.6946" f59 F)) + (bcStrings (8 "-3.2046" f60 F)) + (bcStrings (8 "-3.96" f61 F)) + (bcStrings (8 "-3.7958" f62 F)) + (bcStrings (8 "-2.6146" f63 F)) + (bcStrings (8 "4.5" f64 F)) + (bcStrings (8 "3.9391" f65 F)) + (bcStrings (8 "2.4314" f66 F)) + (bcStrings (8 "0.31632" f67 F)) + (bcStrings (8 "-1.8627" f68 F)) + (bcStrings (8 "-3.6351" f69 F)) + (bcStrings (8 "-4.455" f70 F)) + (bcStrings (8 "-4.2141" f71 F)) + (bcStrings (8 "-2.9314" f72 F)) + (bcStrings (8 "5.04" f73 F)) + (bcStrings (8 "4.3879" f74 F)) + (bcStrings (8 "2.7515" f75 F)) + (bcStrings (8 "0.35369" f76 F)) + (bcStrings (8 "-2.0707" f77 F)) + (bcStrings (8 "-4.0057" f78 F)) + (bcStrings (8 "-4.97" f79 F)) + (bcStrings (8 "-4.6823" f80 F)) + (bcStrings (8 "-3.2382" f81 F)) + (bcStrings (8 "5.505" f82 F)) + (bcStrings (8 "4.8367" f83 F)) + (bcStrings (8 "2.9717" f84 F)) + (bcStrings (8 "0.38505" f85 F)) + (bcStrings (8 "-2.2888" f86 F)) + (bcStrings (8 "-4.4033" f87 F)) + (bcStrings (8 "-5.445" f88 F)) + (bcStrings (8 "-5.1405" f89 F)) + (bcStrings (8 "-3.595" f90 F)) + (bcStrings (8 "6" f91 F)) + (bcStrings (8 "5.2755" f92 F)) + (bcStrings (8 "3.2418" f93 F)) + (bcStrings (8 "0.42442" f94 F)) + (bcStrings (8 "-2.4769" f95 F)) + (bcStrings (8 "-4.8169" f96 F)) + (bcStrings (8 "-5.93" f97 F)) + (bcStrings (8 "-5.6387" f98 F)) + (bcStrings (8 "-3.9319" f99 F))) + htMakeDoneButton('"Continue",'e02dcfColdGen) + htpSetProperty(page,'mx,mx) + htpSetProperty(page,'my,my) + htpSetProperty(page,'nxest,nxest) + htpSetProperty(page,'nyest,nyest) + htpSetProperty(page,'lwrk,lwrk) + htpSetProperty(page,'liwrk,liwrk) + htpSetProperty(page,'s,s) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +e02dcfColdGen htPage == + mx := htpProperty(htPage,'mx) + my := htpProperty(htPage,'my) + nxest := htpProperty(htPage,'nxest) + nyest := htpProperty(htPage,'nyest) + lwrk := htpProperty(htPage,'lwrk) + liwrk := htpProperty(htPage,'liwrk) + s := htpProperty(htPage,'s) + cold := '"c" + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + for i in 1..(mx*my) repeat + end := STRCONC((first y).1," ") + y := rest y + fList := [end,:fList] + fstring := bcwords2liststring fList + for i in 1..my repeat + mid := STRCONC ((first y).1," ") + y := rest y + ylist := [mid,:ylist] + ystring := bcwords2liststring ylist + while y repeat + start := STRCONC ((first y).1," ") + y := rest y + xlist := [start,:xlist] + xstring := bcwords2liststring xlist + -- additional entries needed to get it running + -- but as Start = c they are not used + prefix := STRCONC('"e02dcf(_"",cold,"_",",STRINGIMAGE mx,", [",xstring,"],") + prefix := STRCONC(prefix,STRINGIMAGE my,",[",ystring,"],[",fstring,"], ") + prefix := STRCONC(prefix,STRINGIMAGE s,", ",STRINGIMAGE nxest,", ") + prefix := STRCONC(prefix,STRINGIMAGE nyest,", ",STRINGIMAGE lwrk,", ") + prefix := STRCONC(prefix,STRINGIMAGE liwrk,",0,new(1,", STRINGIMAGE nxest,",0.0)$MATRIX DFLOAT,") + prefix := STRCONC(prefix,"0,new(1,", STRINGIMAGE nyest,",0.0)$MATRIX DFLOAT,") + end := STRCONC("new(1,", STRINGIMAGE lwrk,",0.0)$MATRIX DFLOAT,[[0 for i in 1..") + end := STRCONC(end,STRINGIMAGE liwrk,"]]::Matrix Integer,",STRINGIMAGE ifail,")") + linkGen STRCONC(prefix,end) + + +e02ddf() == + htInitPage('"E02DDF - Least-squares surface fit by bicubic splines with automatic knot placement, scattered data",nil) + htMakePage '( + (domainConditions + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXe02ddf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02ddf| '|NagFittingPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\newline ") + (text . "Determines a bicubic spline approximation to a set of scattered") + (text . " points ( \htbitmap{xr},\htbitmap{yr}, ") + (text . "\htbitmap{fr})") + (text . "with weights \htbitmap{wr}, for r = 1,2,...,m. ") + (text . "The knots \htbitmap{lamdai}, for i = 1,2,...,") + (text . "\htbitmap{nx} and \htbitmap{mui}, for ") + (text . "i = 1,2,...,\htbitmap{ny} are chosen by the routine ") + (text . ", but a single parameter S must be specified to control the ") + (text . "trade-off between closeness of fit and smoothness of fit. This ") + (text . "affects the number of knots required by the spline, which is ") + (text . "given in the B-spline representation \htbitmap{e02daf}") + (text . "\newline \menuitemstyle{}\tab{2} \newline ") + (text . "Number of data points {\it m}: ") + (text . "\newline\tab{2} ") + (bcStrings (6 30 m PI)) + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} ") + (text . "Over-estimate of \htbitmap{nx} of knots \lambda of the ") + (text . "computed spline, {\it nxest}: \newline\tab{2} ") + (bcStrings (6 14 nxest PI)) + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} ") + (text . "Over-estimate of \htbitmap{ny} of knots \mu of the computed ") + (text . "spline, {\it nyest}: \newline\tab{2} ") + (bcStrings (6 14 nyest PI)) + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} \newline ") + (text . "Smoothing factor {\it s}: ") + (text . "\newline\tab{2} ") + (bcStrings (6 "10" s F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Start value: ") + (radioButtons start + ("" " Cold Start - no values needed for {\it nx,ny,lamda,wrk,iwrk}" cold) + ("" " Warm Start - uses knots found in a previous call" warm)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Ifail value: ") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'e02ddfSolve) + htShowPage() + +e02ddfSolve htPage == + m := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) + objValUnwrap htpLabelSpadValue(htPage, 'm) + nxest := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nxest) + objValUnwrap htpLabelSpadValue(htPage, 'nxest) + nyest := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nyest) + objValUnwrap htpLabelSpadValue(htPage, 'nyest) + u := nxest - 4 + v := nyest - 4 + wlist := [u,v] + w := APPLY ('MAX, wlist) + lwrk := (7*u*v + 25*w)*(w + 1) + 2*(u + v + 4*m) + 23*w + 56 + liwrk := m + 2*(nxest - 7)*(nyest - 7) + s := htpLabelInputString(htPage,'s) + initial := htpButtonValue(htPage,'start) + start := + initial = 'cold => '1 + '2 + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + (m = 30 and start = 1) => e02ddfDefaultSolve (htPage,nxest,nyest,lwrk,liwrk,s,ifail) + start = 1 => e02ddfColdSolve (htPage,m,nxest,nyest,lwrk,liwrk,s,ifail) + -- need to change as only wrk(1) is required + labelList := + "append"/[f(i) for i in 1..m] where f(i) == + prefix := ('"\newline \tab{2} ") + middle := ('"\tab{17} ") + post := ('"\tab{32} ") + end := ('"\tab{47} ") + xnam := INTERN STRCONC ('"x",STRINGIMAGE i) + ynam := INTERN STRCONC ('"y",STRINGIMAGE i) + fnam := INTERN STRCONC ('"f",STRINGIMAGE i) + wnam := INTERN STRCONC ('"w",STRINGIMAGE i) + [['text,:prefix],['bcStrings,[8, 0.0, xnam, 'F]], + ['text,:middle],['bcStrings,[8, 0.0, ynam, 'F]], + ['text,:post],['bcStrings,[8, 0.0, fnam, 'F]], + ['text,:end],['bcStrings,[8, 0.0, wnam, 'F]]] + lamdaList := + "append"/[g(i) for i in 1..nxest] where g(i) == + lnam := INTERN STRCONC ('"l",STRINGIMAGE i) + [['bcStrings,[8, 0.0, lnam, 'F]]] + prefix := ('"\blankline \menuitemstyle{} \tab{2} Values of Lamda: \newline") + lamdaList := [['text,:prefix],:lamdaList] + muList := + "append"/[h(i) for i in 1..nyest] where h(i) == + mnam := INTERN STRCONC ('"m",STRINGIMAGE i) + [['bcStrings,[8, 0.0, mnam, 'F]]] + prefix := ('"\blankline \menuitemstyle{} \tab{2} Values of Mu: \newline") + muList := [['text,:prefix],:muList] + prefix := ('"\blankline \menuitemstyle{} \tab{2} Value of nx: \newline \tab{2}") + nxList := [['text,:prefix],['bcStrings,[8, 10, 'nx, 'PI]]] + prefix := ('"\blankline \menuitemstyle{} \tab{2} Value of ny: \newline \tab{2}") + nyList := [['text,:prefix],['bcStrings,[8, 9, 'ny, 'PI]]] + prefix := ('"\blankline \menuitemstyle{} \tab{2} Value of WRK(1): \newline \tab{2}") + wList := [['text,:prefix],['bcStrings,[8, 0.0, 'wone, 'F]]] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :labelList,:lamdaList,:muList,:nxList,:nyList,:wList] + page := htInitPage('"E02DDF - Least-squares surface fit by bicubic splines with automatic knot placement, scattered data",nil) + htSay '"\menuitemstyle{}\tab{2} Values of \space{1} " + htSay '"\htbitmap{xr}: \tab{15} \menuitemstyle{}\tab{17} " + htSay '"Values of \space{1} \htbitmap{yr}: \tab{30}" + htSay '"\menuitemstyle{}\tab{32} Values of \space{1} " + htSay '"\htbitmap{fr}: \tab{45} \menuitemstyle{} " + htSay '"\tab{47} Values of \htbitmap{wr}:" + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'e02ddfWarmGen) + htpSetProperty(page,'m,m) + htpSetProperty(page,'nxest,nxest) + htpSetProperty(page,'nyest,nyest) + htpSetProperty(page,'lwrk,lwrk) + htpSetProperty(page,'liwrk,liwrk) + htpSetProperty(page,'s,s) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + + + +e02ddfColdSolve(htPage,m,nxest,nyest,lwrk,liwrk,s,ifail) == + labelList := + "append"/[f(i) for i in 1..m] where f(i) == + prefix := ('"\newline \tab{2} ") + middle := ('"\tab{17} ") + post := ('"\tab{32} ") + end := ('"\tab{47} ") + xnam := INTERN STRCONC ('"x",STRINGIMAGE i) + ynam := INTERN STRCONC ('"y",STRINGIMAGE i) + fnam := INTERN STRCONC ('"f",STRINGIMAGE i) + wnam := INTERN STRCONC ('"w",STRINGIMAGE i) + [['text,:prefix],['bcStrings,[8, 0.0, xnam, 'F]], + ['text,:middle],['bcStrings,[8, 0.0, ynam, 'F]], + ['text,:post],['bcStrings,[8, 0.0, fnam, 'F]], + ['text,:end],['bcStrings,[8, 0.0, wnam, 'F]]] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :labelList] + page := htInitPage('"E02DDF - Least-squares surface fit by bicubic splines with automatic knot placement, scattered data",nil) + htSay '"\menuitemstyle{}\tab{2} Values of \space{1} " + htSay '"\htbitmap{xr}: \tab{15} \menuitemstyle{}\tab{17} " + htSay '"Values of \space{1} \htbitmap{yr}: \tab{30}" + htSay '"\menuitemstyle{}\tab{32} Values of \space{1} " + htSay '"\htbitmap{fr}: \tab{44} \menuitemstyle{} " + htSay '"\tab{46} Values of \htbitmap{wr}:" + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'e02ddfColdGen) + htpSetProperty(page,'m,m) + htpSetProperty(page,'nxest,nxest) + htpSetProperty(page,'nyest,nyest) + htpSetProperty(page,'lwrk,lwrk) + htpSetProperty(page,'liwrk,liwrk) + htpSetProperty(page,'s,s) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +e02ddfDefaultSolve (htPage,nxest,nyest,lwrk,liwrk,s,ifail) == + m := 30 + page := htInitPage('"E02DDF - Least-squares surface fit by bicubic splines with automatic knot placement, scattered data",nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Values of \htbitmap{xr}:") + (text . "\tab{15} \menuitemstyle{} \tab{17} Values of ") + (text . "\htbitmap{yr}: \tab{30} \menuitemstyle{} \tab{32} ") + (text . "Values of \htbitmap{fr}: \tab{44} \menuitemstyle{} ") + (text . "\tab{46} Values of \htbitmap{wr}:") + (text . "\newline \tab{2} ") + (bcStrings (8 "11.16" x1 F)) + (text . "\tab{17}") + (bcStrings (8 "1.24" y1 F)) + (text . "\tab{32}") + (bcStrings (8 "22.15" f1 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w1 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "12.85" x2 F)) + (text . "\tab{17}") + (bcStrings (8 "3.06" y2 F)) + (text . "\tab{32}") + (bcStrings (8 "22.11" f2 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w2 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "19.85" x3 F)) + (text . "\tab{17}") + (bcStrings (8 "10.72" y3 F)) + (text . "\tab{32}") + (bcStrings (8 "7.97" f3 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w3 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "19.72" x4 F)) + (text . "\tab{17}") + (bcStrings (8 "1.39" y4 F)) + (text . "\tab{32}") + (bcStrings (8 "16.83" f4 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w4 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "15.91" x5 F)) + (text . "\tab{17}") + (bcStrings (8 "7.74" y5 F)) + (text . "\tab{32}") + (bcStrings (8 "15.30" f5 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w5 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "0" x6 F)) + (text . "\tab{17}") + (bcStrings (8 "20" y6 F)) + (text . "\tab{32}") + (bcStrings (8 "34.6" f6 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w6 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "20.87" x7 F)) + (text . "\tab{17}") + (bcStrings (8 "20" y7 F)) + (text . "\tab{32}") + (bcStrings (8 "5.74" f7 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w7 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "3.45" x8 F)) + (text . "\tab{17}") + (bcStrings (8 "12.78" y8 F)) + (text . "\tab{32}") + (bcStrings (8 "41.24" f8 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w8 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "14.26" x9 F)) + (text . "\tab{17}") + (bcStrings (8 "17.87" y9 F)) + (text . "\tab{32}") + (bcStrings (8 "10.74" f9 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w9 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "17.43" x10 F)) + (text . "\tab{17}") + (bcStrings (8 "3.46" y10 F)) + (text . "\tab{32}") + (bcStrings (8 "18.60" f10 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w10 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "22.8" x11 F)) + (text . "\tab{17}") + (bcStrings (8 "12.39" y11 F)) + (text . "\tab{32}") + (bcStrings (8 "5.47" f11 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w11 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "7.58" x12 F)) + (text . "\tab{17}") + (bcStrings (8 "1.98" y12 F)) + (text . "\tab{32}") + (bcStrings (8 "29.87" f12 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w12 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "25" x13 F)) + (text . "\tab{17}") + (bcStrings (8 "11.87" y13 F)) + (text . "\tab{32}") + (bcStrings (8 "4.4" f13 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w13 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "0" x14 F)) + (text . "\tab{17}") + (bcStrings (8 "0" y14 F)) + (text . "\tab{32}") + (bcStrings (8 "58.2" f14 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w14 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "9.66" x15 F)) + (text . "\tab{17}") + (bcStrings (8 "20" y15 F)) + (text . "\tab{32}") + (bcStrings (8 "4.73" f15 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w15 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "5.22" x16 F)) + (text . "\tab{17}") + (bcStrings (8 "14.66" y16 F)) + (text . "\tab{32}") + (bcStrings (8 "40.36" f16 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w16 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "17.25" x17 F)) + (text . "\tab{17}") + (bcStrings (8 "19.57" y17 F)) + (text . "\tab{32}") + (bcStrings (8 "6.43" f17 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w17 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "25" x18 F)) + (text . "\tab{17}") + (bcStrings (8 "3.87" y18 F)) + (text . "\tab{32}") + (bcStrings (8 "8.74" f18 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w18 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "12.13" x19 F)) + (text . "\tab{17}") + (bcStrings (8 "10.79" y19 F)) + (text . "\tab{32}") + (bcStrings (8 "13.71" f19 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w19 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "22.23" x20 F)) + (text . "\tab{17}") + (bcStrings (8 "6.21" y20 F)) + (text . "\tab{32}") + (bcStrings (8 "10.25" f20 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w20 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "11.52" x21 F)) + (text . "\tab{17}") + (bcStrings (8 "8.53" y21 F)) + (text . "\tab{32}") + (bcStrings (8 "15.74" f21 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w21 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "15.2" x22 F)) + (text . "\tab{17}") + (bcStrings (8 "0" y22 F)) + (text . "\tab{32}") + (bcStrings (8 "21.6" f22 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w22 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "7.54" x23 F)) + (text . "\tab{17}") + (bcStrings (8 "10.69" y23 F)) + (text . "\tab{32}") + (bcStrings (8 "19.31" f23 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w23 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "17.32" x24 F)) + (text . "\tab{17}") + (bcStrings (8 "13.78" y24 F)) + (text . "\tab{32}") + (bcStrings (8 "12.11" f24 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w24 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "2.14" x25 F)) + (text . "\tab{17}") + (bcStrings (8 "15.03" y25 F)) + (text . "\tab{32}") + (bcStrings (8 "53.1" f25 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w25 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "0.51" x26 F)) + (text . "\tab{17}") + (bcStrings (8 "8.37" y26 F)) + (text . "\tab{32}") + (bcStrings (8 "49.43" f26 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w26 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "22.69" x27 F)) + (text . "\tab{17}") + (bcStrings (8 "19.63" y27 F)) + (text . "\tab{32}") + (bcStrings (8 "3.25" f27 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w27 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "5.47" x28 F)) + (text . "\tab{17}") + (bcStrings (8 "17.13" y28 F)) + (text . "\tab{32}") + (bcStrings (8 "28.63" f28 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w28 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "21.67" x29 F)) + (text . "\tab{17}") + (bcStrings (8 "14.36" y29 F)) + (text . "\tab{32}") + (bcStrings (8 "5.52" f29 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w29 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "3.31" x30 F)) + (text . "\tab{17}") + (bcStrings (8 "0.33" y30 F)) + (text . "\tab{32}") + (bcStrings (8 "44.08" f30 F)) + (text . "\tab{47}") + (bcStrings (8 "1" w30 F)) + (text . "\blankline")) + htMakeDoneButton('"Continue",'e02ddfColdGen) + htpSetProperty(page,'m,m) + htpSetProperty(page,'nxest,nxest) + htpSetProperty(page,'nyest,nyest) + htpSetProperty(page,'lwrk,lwrk) + htpSetProperty(page,'liwrk,liwrk) + htpSetProperty(page,'s,s) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +e02ddfColdGen htPage == + m := htpProperty(htPage,'m) + nxest := htpProperty(htPage,'nxest) + nyest := htpProperty(htPage,'nyest) + lwrk := htpProperty(htPage,'lwrk) + liwrk := htpProperty(htPage,'liwrk) + s := htpProperty(htPage,'s) + cold := '"c" + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + while y repeat + end := STRCONC ((first y).1," ") + y := rest y + right := STRCONC ((first y).1," ") + y := rest y + mid := STRCONC ((first y).1," ") + y := rest y + left := STRCONC ((first y).1," ") + y := rest y + xlist := [left,:xlist] + ylist := [mid,:ylist] + flist := [right,:flist] + wlist := [end,:wlist] + xstring := bcwords2liststring xlist + ystring := bcwords2liststring ylist + fstring := bcwords2liststring flist + wstring := bcwords2liststring wlist + -- additional entries nx,ny,lamda,mu,wrk needed to get it running + -- but they are just set to 0.0 + prefix := STRCONC('"e02ddf(_"",cold,"_",",STRINGIMAGE m,", [",xstring,"],[") + prefix := STRCONC(prefix,ystring,"],[",fstring,"],[",wstring,"], ") + prefix := STRCONC(prefix,STRINGIMAGE s,", ",STRINGIMAGE nxest,", ") + prefix := STRCONC(prefix,STRINGIMAGE nyest,", ",STRINGIMAGE lwrk,", ") + prefix := STRCONC(prefix,STRINGIMAGE liwrk,", 0,") + prefix := STRCONC(prefix,"new(1,", STRINGIMAGE nxest,",0.0)$MATRIX DFLOAT,0,") + prefix := STRCONC(prefix,"new(1,", STRINGIMAGE nyest,",0.0)$MATRIX DFLOAT,") + prefix := STRCONC(prefix,"new(1,", STRINGIMAGE lwrk,",0.0)$MATRIX DFLOAT,") +-- prefix := STRCONC(prefix,"[[0.0 for i in 1..", STRINGIMAGE nxest,"]],0,") +-- prefix := STRCONC(prefix,"[[0.0 for i in 1..", STRINGIMAGE nyest,"]],") +-- prefix := STRCONC(prefix,"[[0.0 for i in 1..", STRINGIMAGE lwrk,"]],") + prefix := STRCONC(prefix,STRINGIMAGE ifail,")") + linkGen prefix + +e02ddfWarmGen htPage == + m := htpProperty(htPage,'m) + nxest := htpProperty(htPage,'nxest) + nyest := htpProperty(htPage,'nyest) + lwrk := htpProperty(htPage,'lwrk) + liwrk := htpProperty(htPage,'liwrk) + s := htpProperty(htPage,'s) + warm := '"w" + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + wrk := (first y).1 + y := rest y + for i in 1..lwrk repeat + wrkList := ['"0.0 ",:wrkList] + wrkList := [wrk,:wrkList] + wrkstring := bcwords2liststring wrkList + ny := STRCONC((first y).1," ") + y := rest y + nx := STRCONC((first y).1," ") + y := rest y + for i in 1..nyest repeat + mu := STRCONC ((first y).1, " ") + y := rest y + muList := [mu,:muList] + mustring := bcwords2liststring muList + for i in 1..nxest repeat + lam := STRCONC ((first y).1, " ") + y := rest y + lamList := [lam,:lamList] + lamstring := bcwords2liststring lamList + while y repeat + end := STRCONC ((first y).1," ") + y := rest y + right := STRCONC ((first y).1," ") + y := rest y + mid := STRCONC ((first y).1," ") + y := rest y + left := STRCONC ((first y).1," ") + y := rest y + xlist := [left,:xlist] + ylist := [mid,:ylist] + flist := [right,:flist] + wlist := [end,:wlist] + xstring := bcwords2liststring xlist + ystring := bcwords2liststring ylist + fstring := bcwords2liststring flist + wstring := bcwords2liststring wlist + -- additional entries nx,ny,lamda,mu,wrk needed to get it running + -- but they are just set to 0.0 + prefix := STRCONC('"e02ddf(_"",warm,"_",",STRINGIMAGE m,", [",xstring,"],[") + prefix := STRCONC(prefix,ystring,"],[",fstring,"],[",wstring,"], ") + prefix := STRCONC(prefix,STRINGIMAGE s,", ",STRINGIMAGE nxest,", ") + prefix := STRCONC(prefix,STRINGIMAGE nyest,", ",STRINGIMAGE lwrk,", ") + prefix := STRCONC(prefix,STRINGIMAGE liwrk,", ",nx,",[",lamstring,"],",ny) + prefix := STRCONC(prefix,",[",mustring,"],[",wrkstring,"],") + prefix := STRCONC(prefix,STRINGIMAGE ifail,")") + linkGen prefix + +e02zaf() == + htInitPage('"E02ZAF - Sort 2-D sata into panels for fitting bicubic splines",nil) + htMakePage '( + (domainConditions + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXe02zaf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02zaf| '|NagFittingPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "Sorts the set of points {\em (\htbitmap{xr},") + (text . "\htbitmap{yr})} into panels defined by \space{1}") + (text . "\htbitmap{px} -8 points \htbitmap{lamdai} ") + (text . "on the x-axis and \space{1}\htbitmap{py}-8 points ") + (text . "\htbitmap{muj} on the y axis. The points are ordered ") + (text . "so that all points in a panel occur before data in succeeding ") + (text . "panels. Within a panel, the points maintain their original ") + (text . "order. ") + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} \newline ") + (text . "Number of points to be sorted to be sorted {\it m}: ") + (text . "\newline\tab{2} ") + (bcStrings (6 10 m PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "\newline Intercepts + 8 on x axis {\em px}:") + (text . "\tab{32} \menuitemstyle{}\tab{34}") + (text . "Intercepts + 8 on y axis {\em py}:") + (text . "\newline\tab{2} ") + (bcStrings (6 9 px PI)) + (text . "\tab{34} ") + (bcStrings (6 10 py PI)) + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} \newline ") + (text . "Dimension of point {\it npoint}: ") + (text . "\newline\tab{2} ") + (bcStrings (6 45 npoint PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Ifail value: ") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'e02zafSolve) + htShowPage() + +e02zafSolve htPage == + m := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) + objValUnwrap htpLabelSpadValue(htPage, 'm) + px := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'px) + objValUnwrap htpLabelSpadValue(htPage, 'px) + py := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'py) + objValUnwrap htpLabelSpadValue(htPage, 'py) + npoint := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'npoint) + objValUnwrap htpLabelSpadValue(htPage, 'npoint) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + ((m = '10 and px = '9) and py = '10) => e02zafDefaultSolve(htPage,npoint,ifail) + labelList := + "append"/[fxy(i) for i in 1..m] where fxy(i) == + prefix := ('"\newline \tab{2} ") + middle := ('"\tab{32} ") + lnam := INTERN STRCONC ('"x",STRINGIMAGE i) + cnam := INTERN STRCONC ('"y",STRINGIMAGE i) + [['text,:prefix],['bcStrings,[8, 0.0, lnam, 'F]], + ['text,:middle],['bcStrings,[8, 0.0, cnam, 'F]]] + lamList := + "append"/[flam(i) for i in 5..(px-4)] where flam(i) == + lnam := INTERN STRCONC ('"l",STRINGIMAGE i) + [['bcStrings,[8, 0.0, lnam, 'F]]] + prefix := ('"\blankline \menuitemstyle{} \tab{2} {\it \lambda(5) to ") + prefix := STRCONC(prefix,"\lambda(px-4)}: \newline \tab{2} ") + lamList := [['text,:prefix],:lamList] + muList := + "append"/[fmu(i) for i in 5..(py-4)] where fmu(i) == + mnam := INTERN STRCONC ('"m",STRINGIMAGE i) + [['bcStrings,[8, 0.0, mnam, 'F]]] + prefix := ('"\blankline \menuitemstyle{} \tab{2} {\it \mu(5) to \mu(py-4)}: ") + prefix := STRCONC(prefix,"\newline \tab{2} ") + muList := [['text,:prefix],:muList] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :labelList,:lamList,:muList] + page := htInitPage('"E02ZAF - Sort 2-D sata into panels for fitting bicubic splines",nil) + htSay '"\menuitemstyle{}\tab{2} {\it x(m)}: " + htSay '"\tab{30} \menuitemstyle{}\tab{32} {\it y(m)}: " + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'e02zafGen) + htpSetProperty(page,'m,m) + htpSetProperty(page,'px,px) + htpSetProperty(page,'py,py) + htpSetProperty(page,'npoint,npoint) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +e02zafDefaultSolve (htPage,npoint,ifail) == + m := '10 + px := '9 + py := '10 + page := htInitPage('"E02ZAF - Sort 2-D sata into panels for fitting bicubic splines",nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} {\it x(m)}:") + (text . "\tab{30} \menuitemstyle{} \tab{32} {\it y(m)}:") + (text . "\newline \tab{2} ") + (bcStrings (8 "0.00" x1 F)) + (text . "\tab{32}") + (bcStrings (8 "0.77" y1 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "0.70" x2 F)) + (text . "\tab{32}") + (bcStrings (8 "1.06" y2 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "1.44" x3 F)) + (text . "\tab{32}") + (bcStrings (8 "0.33" y3 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "0.21" x4 F)) + (text . "\tab{32}") + (bcStrings (8 "0.44" y4 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "1.01" x5 F)) + (text . "\tab{32}") + (bcStrings (8 "0.50" y5 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "1.84" x6 F)) + (text . "\tab{32}") + (bcStrings (8 "0.02" y6 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "0.71" x7 F)) + (text . "\tab{32}") + (bcStrings (8 "1.95" y7 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "1.00" x8 F)) + (text . "\tab{32}") + (bcStrings (8 "1.20" y8 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "0.54" x9 F)) + (text . "\tab{32}") + (bcStrings (8 "0.04" y9 F)) + (text . "\newline \tab{2} ") + (bcStrings (8 "1.531" x10 F)) + (text . "\tab{32}") + (bcStrings (8 "0.18" y10 F)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2} {\it \lambda(5) to \lambda(px-4)}:") + (text . "\newline \tab{2}") + (bcStrings (8 "1.00" l5 F)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2} {\it \mu(5) to \mu(py-4)}:") + (text . "\newline \tab{2}") + (bcStrings (8 "0.80" mu5 F)) + (bcStrings (8 "1.20" mu6 F)) + (text . "\blankline ")) + htMakeDoneButton('"Continue",'e02zafGen) + htpSetProperty(page,'m,m) + htpSetProperty(page,'px,px) + htpSetProperty(page,'py,py) + htpSetProperty(page,'npoint,npoint) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +e02zafGen htPage == + m := htpProperty(htPage,'m) + px := htpProperty(htPage,'px) + py := htpProperty(htPage,'py) + npoint := htpProperty(htPage,'npoint) + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + nadres := (px-7)*(py-7) + -- mu + for i in 1..4 repeat + muList := ['"0 ",:muList] + for i in 5..(py-4) repeat + right := STRCONC ((first y).1," ") + y := rest y + muList := [right,:muList] + for i in (py-3)..py repeat + muList := ['"0 ",:muList] + mustring := bcwords2liststring muList + -- lamda + for i in 1..4 repeat + lamList := ['"0 ",:lamList] + for i in 5..(px-4) repeat + right := STRCONC ((first y).1," ") + y := rest y + lamList := [right,:lamList] + for i in (px-3)..px repeat + lamList := ['"0 ",:lamList] + lamstring := bcwords2liststring lamList + -- x & y + while y repeat + right := STRCONC ((first y).1," ") + y := rest y + left := STRCONC ((first y).1," ") + y := rest y + xlist := [left,:xlist] + ylist := [right,:ylist] + xstring := bcwords2liststring xlist + ystring := bcwords2liststring ylist + prefix := STRCONC('"e02zaf(",STRINGIMAGE px,", ",STRINGIMAGE py,",[") + prefix := STRCONC(prefix,lamstring,"],[",mustring,"], ",STRINGIMAGE m,", [") + prefix := STRCONC(prefix,xstring,"],[",ystring,"], ",STRINGIMAGE npoint,", ") + prefix := STRCONC(prefix,STRINGIMAGE nadres,", ",STRINGIMAGE ifail,")") + linkGen prefix + + + diff --git a/src/interp/nag-e02b.boot.pamphlet b/src/interp/nag-e02b.boot.pamphlet deleted file mode 100644 index 85f29cfb..00000000 --- a/src/interp/nag-e02b.boot.pamphlet +++ /dev/null @@ -1,1759 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp nag-e02b.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. - -@ -<<*>>= -<> - -)package "BOOT" - --- READ THIS NOW! --- --- The automatic make fails to compile this file properly, leaving a --- truncated clisp file in int/interp. So if you change this file it --- must be compiled by hand in the interpreter (which works fine). --- MCD. --- - -e02daf() == - htInitPage('"E02DAF - Least-squares surface fit, bicubic splines",nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXe02daf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02daf| '|NagFittingPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "Determines a minimal, least squares bicubic B-spline surface fit") - (text . "\htbitmap{e02daf} to the set of points ") - (text . "{\em (\htbitmap{xr},\htbitmap{yr},\htbitmap{fr})} with weights ") - (text . "\htbitmap{wr}, for r = 1,2,...,m. The user must supply internal ") - (text . "knot sets {\lambda},in the x-direction and {\mu} in the ") - (text . "y-direction, ") - (text . "which can be thought of as dividing the data region into panels;") - (text . "s(x,y) consists of a seperate bicubic polynomial in each panel, ") - (text . "the polynomial joining together with second derivative ") - (text . "continuity. Eight additional (external) knots are added to each ") - (text . "of the knot sets by this routine. The routine minimizes \Sigma, ") - (text . "the sum of squares of the weighted residuals ") - (text . "\htbitmap{e02daf1}, for r = 1,2,...,m, subject to the ") - (text . "given knot sets. \newline ") - (text . "A call of this routine should be preceded by a call of E02ZAF ") - (text . "to provide indexing information. ") - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} \newline ") - (text . "Number of data points {\it m}: ") - (text . "\newline\tab{2} ") - (bcStrings (6 30 m PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "\newline Knots in x direction {\em px}") - (text . "\htbitmap{great=} 8: \tab{32} \menuitemstyle{}\tab{34}") - (text . "Knots in y direction {\em py}:") - (text . "\newline\tab{2} ") - (bcStrings (6 8 px PI)) - (text . "\tab{34} ") - (bcStrings (6 10 py PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "\newline Rank threshold {\em eps}:") - (text . "\newline\tab{2} ") - (bcStrings (10 "0.000001" eps F)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} \newline ") - (text . "Dimension of point {\it npoint}: ") - (text . "\newline\tab{2} ") - (bcStrings (6 43 npoint PI)) - -- include a radio button later to allow switching of - -- x & y if px <= py - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'e02dafSolve) - htShowPage() - -e02dafSolve htPage == - m := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) - objValUnwrap htpLabelSpadValue(htPage, 'm) - px := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'px) - objValUnwrap htpLabelSpadValue(htPage, 'px) - py := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'py) - objValUnwrap htpLabelSpadValue(htPage, 'py) - npoint := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'npoint) - objValUnwrap htpLabelSpadValue(htPage, 'npoint) - nc := (px - 4)*(py - 4) - nws := (2*nc + 1)*(3*py - 6) -2 - eps := htpLabelInputString(htPage,'eps) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - ((m = '30 and px = '8) and py = '10) => e02dafDefaultSolve(htPage,eps,nws,npoint,ifail) - labelList := - "append"/[fxy(i) for i in 1..m] where fxy(i) == - prefix := ('"\newline \tab{2} ") - middle := ('"\tab{17} ") - next := ('"\tab{32} ") - end := ('"\tab{47} ") - xnam := INTERN STRCONC ('"x",STRINGIMAGE i) - ynam := INTERN STRCONC ('"y",STRINGIMAGE i) - fnam := INTERN STRCONC ('"f",STRINGIMAGE i) - wnam := INTERN STRCONC ('"w",STRINGIMAGE i) - [['text,:prefix],['bcStrings,[8, 0.0, xnam, 'F]], - ['text,:middle],['bcStrings,[8, 0.0, ynam, 'F]], - ['text,:next],['bcStrings,[8, 0.0, fnam, 'F]], - ['text,:end],['bcStrings,[8, 0.0, wnam, 'F]]] - lamList := - "append"/[flam(i) for i in 5..(px-4)] where flam(i) == - lnam := INTERN STRCONC ('"l",STRINGIMAGE i) - [['bcStrings,[8, 0.0, lnam, 'F]]] - prefix := ('"\blankline \menuitemstyle{} \tab{2} lamda(5) to lamda(px-4): ") - prefix := STRCONC(prefix,"\newline \tab{2} ") - postfix := ('"\newline \blankline ") - lamList := [['text,:prefix],:lamList,['text,:postfix]] - muList := - "append"/[fmu(i) for i in 5..(py-4)] where fmu(i) == - mnam := INTERN STRCONC ('"m",STRINGIMAGE i) - [['bcStrings,[8, 0.0, mnam, 'F]]] - prefix := ('"\menuitemstyle{} \tab{2} mu(5) to mu(py-4):") - prefix := STRCONC(prefix,"\newline \tab{2} ") - muList := [['text,:prefix],:muList] - pList := - "append"/[fp(i) for i in 1..npoint] where fp(i) == - prefix := ('"\newline \tab{2} ") - pnam := INTERN STRCONC ('"p",STRINGIMAGE i) - [['text,:prefix],['bcStrings,[8, 0.0, pnam, 'F]]] - prefix := ('"\blankline \menuitemstyle{} \tab{2} Enter values of Point: ") - pList := [['text,:prefix],:pList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :labelList,:lamList,:muList,:pList] - page := htInitPage('"E02DAF - Least-squares surface fit, bicubic splines",nil) - htSay '"\menuitemstyle{}\tab{2} Values of \htbitmap{xr}: " - htSay '"\tab{15} \menuitemstyle{}\tab{17} Values of \htbitmap{yr}:" - htSay '"\tab{30} \menuitemstyle{}\tab{32} Values of \htbitmap{fr}:" - htSay '"\tab{44} \menuitemstyle{}\tab{46} Values of \htbitmap{wr}:" - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'e02dafGen) - htpSetProperty(page,'m,m) - htpSetProperty(page,'px,px) - htpSetProperty(page,'py,py) - htpSetProperty(page,'nws,nws) - htpSetProperty(page,'eps,eps) - htpSetProperty(page,'npoint,npoint) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -e02dafDefaultSolve (htPage,eps,nws,npoint,ifail) == - m := '30 - px := '8 - py := '10 - page := htInitPage('"E02DAF - Least-squares surface fit, bicubic splines",nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Values of \htbitmap{xr}:") - (text . "\tab{15} \menuitemstyle{} \tab{17} Values of ") - (text . "\htbitmap{yr}: \tab{30} \menuitemstyle{} \tab{32} ") - (text . "Values of \htbitmap{fr}: \tab{44} \menuitemstyle{} ") - (text . "\tab{46} Values of \htbitmap{wr}:") - (text . "\newline \tab{2} ") - (bcStrings (8 "-0.52" x1 F)) - (text . "\tab{17}") - (bcStrings (8 "0.60" y1 F)) - (text . "\tab{32}") - (bcStrings (8 "0.93" f1 F)) - (text . "\tab{47}") - (bcStrings (8 "10" w1 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "-0.61" x2 F)) - (text . "\tab{17}") - (bcStrings (8 "-0.95" y2 F)) - (text . "\tab{32}") - (bcStrings (8 "-1.79" f2 F)) - (text . "\tab{47}") - (bcStrings (8 "10" w2 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "0.93" x3 F)) - (text . "\tab{17}") - (bcStrings (8 "0.87" y3 F)) - (text . "\tab{32}") - (bcStrings (8 "0.36" f3 F)) - (text . "\tab{47}") - (bcStrings (8 "10" w3 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "0.09" x4 F)) - (text . "\tab{17}") - (bcStrings (8 "0.84" y4 F)) - (text . "\tab{32}") - (bcStrings (8 "0.52" f4 F)) - (text . "\tab{47}") - (bcStrings (8 "10" w4 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "0.88" x5 F)) - (text . "\tab{17}") - (bcStrings (8 "0.17" y5 F)) - (text . "\tab{32}") - (bcStrings (8 "0.49" f5 F)) - (text . "\tab{47}") - (bcStrings (8 "10" w5 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "-0.70" x6 F)) - (text . "\tab{17}") - (bcStrings (8 "-0.87" y6 F)) - (text . "\tab{32}") - (bcStrings (8 "-1.76" f6 F)) - (text . "\tab{47}") - (bcStrings (8 "10" w6 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "1" x7 F)) - (text . "\tab{17}") - (bcStrings (8 "1" y7 F)) - (text . "\tab{32}") - (bcStrings (8 "0.33" f7 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w7 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "1" x8 F)) - (text . "\tab{17}") - (bcStrings (8 "0.1" y8 F)) - (text . "\tab{32}") - (bcStrings (8 "0.48" f8 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w8 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "0.3" x9 F)) - (text . "\tab{17}") - (bcStrings (8 "0.24" y9 F)) - (text . "\tab{32}") - (bcStrings (8 "0.65" f9 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w9 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "-0.77" x10 F)) - (text . "\tab{17}") - (bcStrings (8 "-0.77" y10 F)) - (text . "\tab{32}") - (bcStrings (8 "-1.82" f10 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w10 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "-0.23" x11 F)) - (text . "\tab{17}") - (bcStrings (8 "0.32" y11 F)) - (text . "\tab{32}") - (bcStrings (8 "0.92" f11 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w11 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "-1" x12 F)) - (text . "\tab{17}") - (bcStrings (8 "1" y12 F)) - (text . "\tab{32}") - (bcStrings (8 "1" f12 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w12 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "-0.26" x13 F)) - (text . "\tab{17}") - (bcStrings (8 "-0.63" y13 F)) - (text . "\tab{32}") - (bcStrings (8 "8.88" f13 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w13 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "-0.83" x14 F)) - (text . "\tab{17}") - (bcStrings (8 "-0.66" y14 F)) - (text . "\tab{32}") - (bcStrings (8 "-2.01" f14 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w14 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "0.22" x15 F)) - (text . "\tab{17}") - (bcStrings (8 "0.93" y15 F)) - (text . "\tab{32}") - (bcStrings (8 "0.47" f15 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w15 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "0.89" x16 F)) - (text . "\tab{17}") - (bcStrings (8 "0.15" y16 F)) - (text . "\tab{32}") - (bcStrings (8 "0.49" f16 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w16 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "-0.80" x17 F)) - (text . "\tab{17}") - (bcStrings (8 "0.99" y17 F)) - (text . "\tab{32}") - (bcStrings (8 "0.84" f17 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w17 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "-0.88" x18 F)) - (text . "\tab{17}") - (bcStrings (8 "-0.54" y18 F)) - (text . "\tab{32}") - (bcStrings (8 "-2.42" f18 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w18 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "0.68" x19 F)) - (text . "\tab{17}") - (bcStrings (8 "0.44" y19 F)) - (text . "\tab{32}") - (bcStrings (8 "0.47" f19 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w19 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "-0.14" x20 F)) - (text . "\tab{17}") - (bcStrings (8 "-0.72" y20 F)) - (text . "\tab{32}") - (bcStrings (8 "7.15" f20 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w20 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "0.67" x21 F)) - (text . "\tab{17}") - (bcStrings (8 "0.63" y21 F)) - (text . "\tab{32}") - (bcStrings (8 "0.44" f21 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w21 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "-0.90" x22 F)) - (text . "\tab{17}") - (bcStrings (8 "-0.40" y22 F)) - (text . "\tab{32}") - (bcStrings (8 "-3.34" f22 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w22 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "-0.84" x23 F)) - (text . "\tab{17}") - (bcStrings (8 "0.20" y23 F)) - (text . "\tab{32}") - (bcStrings (8 "2.78" f23 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w23 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "0.84" x24 F)) - (text . "\tab{17}") - (bcStrings (8 "0.43" y24 F)) - (text . "\tab{32}") - (bcStrings (8 "0.44" f24 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w24 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "0.15" x25 F)) - (text . "\tab{17}") - (bcStrings (8 "0.28" y25 F)) - (text . "\tab{32}") - (bcStrings (8 "0.70" f25 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w25 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "-0.91" x26 F)) - (text . "\tab{17}") - (bcStrings (8 "-0.24" y26 F)) - (text . "\tab{32}") - (bcStrings (8 "-6.52" f26 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w26 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "-0.35" x27 F)) - (text . "\tab{17}") - (bcStrings (8 "0.86" y27 F)) - (text . "\tab{32}") - (bcStrings (8 "0.66" f27 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w27 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "-0.16" x28 F)) - (text . "\tab{17}") - (bcStrings (8 "-0.41" y28 F)) - (text . "\tab{32}") - (bcStrings (8 "2.32" f28 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w28 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "-0.35" x29 F)) - (text . "\tab{17}") - (bcStrings (8 "-0.05" y29 F)) - (text . "\tab{32}") - (bcStrings (8 "1.66" f29 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w29 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "-1" x30 F)) - (text . "\tab{17}") - (bcStrings (8 "-1" y30 F)) - (text . "\tab{32}") - (bcStrings (8 "-1" f30 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w30 F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} mu(5) to mu(py-4):") - (text . "\newline \tab{2}") - (bcStrings (8 "-0.50" mu5 F)) - (bcStrings (8 "0.00" mu6 F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} Enter values for point:") - (text . "\newline \tab{2}") - (bcStrings (6 3 p1 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 6 p2 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 4 p3 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 5 p4 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 7 p5 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 10 p6 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 8 p7 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 9 p8 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 11 p9 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 13 p10 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 12 p11 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 15 p12 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 14 p13 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 18 p14 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 16 p15 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 17 p16 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 19 p17 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 20 p18 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 21 p19 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 30 p20 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 23 p21 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 26 p22 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 24 p23 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 25 p24 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 27 p25 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 28 p26 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 0 p27 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 29 p28 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 0 p29 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 0 p30 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 2 p31 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 22 p32 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 1 p33 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 0 p34 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 0 p35 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 0 p36 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 0 p37 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 0 p38 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 0 p39 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 0 p40 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 0 p41 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 0 p42 PI)) - (text . "\newline \tab{2}") - (bcStrings (6 0 p43 PI)) - (text . "\blankline")) - htMakeDoneButton('"Continue",'e02dafGen) - htpSetProperty(page,'m,m) - htpSetProperty(page,'px,px) - htpSetProperty(page,'py,py) - htpSetProperty(page,'nws,nws) - htpSetProperty(page,'eps,eps) - htpSetProperty(page,'npoint,npoint) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -e02dafGen htPage == - m := htpProperty(htPage,'m) - px := htpProperty(htPage,'px) - py := htpProperty(htPage,'py) - nws := htpProperty(htPage,'nws) - eps := htpProperty(htPage,'eps) - npoint := htpProperty(htPage,'npoint) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - nadres := (px-7)*(py-7) - -- point - for i in 1..npoint repeat - right := STRCONC ((first y).1," ") - y := rest y - pointList := [right,:pointList] - pstring := bcwords2liststring pointList - -- mu - for i in 1..4 repeat - muList := ['"0 ",:muList] - for i in 5..(py-4) repeat - right := STRCONC ((first y).1," ") - y := rest y - muList := [right,:muList] - for i in (py-3)..py repeat - muList := ['"0 ",:muList] - mustring := bcwords2liststring muList - -- lamda - for i in 1..4 repeat - lamList := ['"0 ",:lamList] - for i in 5..(px-4) repeat - right := STRCONC ((first y).1," ") - y := rest y - lamList := [right,:lamList] - for i in (px-3)..px repeat - lamList := ['"0 ",:lamList] - lamstring := bcwords2liststring lamList - -- x & y - while y repeat - one := STRCONC((first y).1," ") - y := rest y - two := STRCONC((first y).1," ") - y := rest y - three := STRCONC ((first y).1," ") - y := rest y - four := STRCONC ((first y).1," ") - y := rest y - xlist := [four,:xlist] - ylist := [three,:ylist] - flist := [two,:flist] - wlist := [one,:wlist] - xstring := bcwords2liststring xlist - ystring := bcwords2liststring ylist - fstring := bcwords2liststring flist - wstring := bcwords2liststring wlist - nc := (px-4)*(py-4) - prefix := STRCONC('"e02daf(",STRINGIMAGE m,", ",STRINGIMAGE px,", ") - prefix := STRCONC(prefix,STRINGIMAGE py,",[",xstring,"],[",ystring,"],[") - prefix := STRCONC(prefix,fstring,"],[",wstring,"],[",mustring,"],[") - prefix := STRCONC(prefix,pstring,"], ",STRINGIMAGE npoint,", ") - prefix := STRCONC(prefix,STRINGIMAGE nc,", ",STRINGIMAGE nws,", ",eps,", [") - prefix := STRCONC(prefix,lamstring,"], ",STRINGIMAGE ifail,")") - linkGen prefix - - -e02dcf() == - htInitPage('"E02DCF - Least-squares curve by bicubic splines with automatic knot placement, data on a rectangular grid",nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXe02dcf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02dcf| '|NagFittingPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "Determines a bicubic spline approximation to a set of points ") - (text . "given on a rectangular grid defined by \htbitmap{mx} ") - (text . "points \htbitmap{xq} on the x-axis and ") - (text . "\htbitmap{my} points \htbitmap{yr} on the ") - (text . "y-axix. The knots \htbitmap{lamdai}, for i = 1,2,...,") - (text . "\htbitmap{nx} and \htbitmap{mui}, for ") - (text . "i = 1,2,...,\htbitmap{ny} are chosen for this routine ") - (text . ", but a single parameter S must be specified to control the ") - (text . "trade-off between closeness of fit and smoothness of fit. This ") - (text . "affects the number of knots required by the spline, which is ") - (text . "given in the B-spline representation \htbitmap{e02daf}") - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} \newline ") - (text . "Grid points on x-axis \htbitmap{mx}: ") - (text . "\tab{30} \menuitemstyle{}\tab{32} Grid points on y-axis ") - (text . "\htbitmap{my}: ") - (text . "\newline\tab{2} ") - (bcStrings (6 11 mx PI)) - (text . "\tab{32} ") - (bcStrings (6 9 my PI)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") - (text . "Over-estimate of \htbitmap{nx} of knots \lambda of the ") - (text . "computed spline, {\it nxest}: \newline\tab{2} ") - (bcStrings (6 15 nxest PI)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") - (text . "Over-estimate of \htbitmap{ny} of knots \mu of the computed ") - (text . "spline, {\it nyest}: \newline\tab{2} ") - (bcStrings (6 13 nyest PI)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} \newline ") - (text . "Smoothing factor {\it s}: ") - (text . "\newline\tab{2} ") - (bcStrings (6 "0.1" s F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Start value: ") - (radioButtons start - ("" " Cold Start - no values needed for {\it nx,ny,lamda,mu} or {\it iwrk}" cold) - ("" " Warm Start - uses knots found in a previous call" warm)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'e02dcfSolve) - htShowPage() - -e02dcfSolve htPage == - mx := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'mx) - objValUnwrap htpLabelSpadValue(htPage, 'mx) - my := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'my) - objValUnwrap htpLabelSpadValue(htPage, 'my) - nxest := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nxest) - objValUnwrap htpLabelSpadValue(htPage, 'nxest) - nyest := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nyest) - objValUnwrap htpLabelSpadValue(htPage, 'nyest) - wrklist := [my,nxest] - wrkmax := APPLY ('MAX, wrklist) - lwrk := 4*(mx + my) +11*(nxest + nyest) + nxest*my + wrkmax +54 - liwrk := 3 + mx + my + nxest + nyest - s := htpLabelInputString(htPage,'s) - initial := htpButtonValue(htPage,'start) - start := - initial = 'cold => '1 - '2 - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - ((mx = 11 and my = 9) and start = 1) => - e02dcfDefaultSolve (htPage,nxest,nyest,lwrk,liwrk,s,ifail) - start = 1 => e02dcfColdSolve (htPage,mx,my,nxest,nyest,lwrk,liwrk,s,ifail) - -- warm start not really possible from hyperdoc - -- as inputing a workspace array of dimension 592 is asking too much - -- user should use the command line, using the previous calculated - -- parameters - htInitPage('"E02DCF - Least-squares curve by bicubic splines with automatic knot placement, data on a rectangular grid",nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\blankline ") - (text . "{\center{\em Hyperdoc interface not available for warm starts.}}") - (text . "\newline ") - (text . "{\center{\em Please use the command line.}}")) - htMakeDoneButton('"Continue",'e02dcf) - htShowPage() - - - -e02dcfColdSolve(htPage,mx,my,nxest,nyest,lwrk,liwrk,s,ifail) == - xList := - "append"/[f(i) for i in 1..mx] where f(i) == - xnam := INTERN STRCONC ('"x",STRINGIMAGE i) - [['bcStrings,[8, 0.0, xnam, 'F]]] - yList := - "append"/[g(i) for i in 1..my] where g(i) == - ynam := INTERN STRCONC ('"g",STRINGIMAGE i) - [['bcStrings,[8, 0.0, ynam, 'F]]] - prefix:= ('"\blankline \menuitemstyle{}\tab{2} Values of {\it y(my)}: \newline ") - yList := [['text,:prefix],:yList] - fList := - "append"/[h(i) for i in 1..(mx*my)] where h(i) == - fnam := INTERN STRCONC ('"g",STRINGIMAGE i) - [['bcStrings,[8, 0.0, fnam, 'F]]] - prefix:=('"\blankline \menuitemstyle{} \tab{2} Values of {\it f(mx*my)}: \newline ") - fList := [['text,:prefix],:fList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :xList,:yList,:fList] - page := htInitPage('"E02DCF - Least-squares curve by bicubic splines with automatic knot placement, data on a rectangular grid",nil) - htSay '"\menuitemstyle{}\tab{2} Values of {\it x(mx)}: \newline " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'e02dcfColdGen) - htpSetProperty(page,'mx,mx) - htpSetProperty(page,'my,my) - htpSetProperty(page,'nxest,nxest) - htpSetProperty(page,'nyest,nyest) - htpSetProperty(page,'lwrk,lwrk) - htpSetProperty(page,'liwrk,liwrk) - htpSetProperty(page,'s,s) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -e02dcfDefaultSolve (htPage,nxest,nyest,lwrk,liwrk,s,ifail) == - mx := 11 - my := 9 - page := htInitPage('"E02DCF - Least-squares curve by bicubic splines with automatic knot placement, data on a rectangular grid",nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Values of {\it x(mx)}:") - (text . "\newline ") - (bcStrings (8 "0" x1 F)) - (bcStrings (8 "0.5" x2 F)) - (bcStrings (8 "1" x3 F)) - (bcStrings (8 "1.5" x4 F)) - (bcStrings (8 "2" x5 F)) - (bcStrings (8 "2.5" x6 F)) - (bcStrings (8 "3" x7 F)) - (bcStrings (8 "3.5" x8 F)) - (bcStrings (8 "4" x9 F)) - (bcStrings (8 "4.5" x10 F)) - (bcStrings (8 "5" x11 F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} Values of {\it y(my)}:") - (text . "\newline ") - (bcStrings (8 "0" y1 F)) - (bcStrings (8 "0.5" y2 F)) - (bcStrings (8 "1" y3 F)) - (bcStrings (8 "1.5" y4 F)) - (bcStrings (8 "2" y5 F)) - (bcStrings (8 "2.5" y6 F)) - (bcStrings (8 "3" y7 F)) - (bcStrings (8 "3.5" y8 F)) - (bcStrings (8 "4" y9 F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} Values of {\it f(mx*my)}:") - (text . "\newline ") - (bcStrings (8 "1" f1 F)) - (bcStrings (8 "0.88758" f2 F)) - (bcStrings (8 "0.5403" f3 F)) - (bcStrings (8 "0.070737" f4 F)) - (bcStrings (8 "-0.41515" f5 F)) - (bcStrings (8 "-0.80114" f6 F)) - (bcStrings (8 "-0.97999" f7 F)) - (bcStrings (8 "-0.93446" f8 F)) - (bcStrings (8 "-0.65664" f9 F)) - (bcStrings (8 "1.5" f10 F)) - (bcStrings (8 "1.3564" f11 F)) - (bcStrings (8 "0.82045" f12 F)) - (bcStrings (8 "0.10611" f13 F)) - (bcStrings (8 "-0.62422" f14 F)) - (bcStrings (8 "-1.2317" f15 F)) - (bcStrings (8 "-1.485" f16 F)) - (bcStrings (8 "-1.3047" f17 F)) - (bcStrings (8 "-0.98547" f18 F)) - (bcStrings (8 "2.06" f19 F)) - (bcStrings (8 "1.7552" f20 F)) - (bcStrings (8 "1.0806" f21 F)) - (bcStrings (8 "0.15147" f22 F)) - (bcStrings (8 "-0.83229" f23 F)) - (bcStrings (8 "-1.6023" f24 F)) - (bcStrings (8 "-1.97" f25 F)) - (bcStrings (8 "-1.8729" f26 F)) - (bcStrings (8 "-1.4073" f27 F)) - (bcStrings (8 "2.57" f28 F)) - (bcStrings (8 "2.124" f29 F)) - (bcStrings (8 "1.3508" f30 F)) - (bcStrings (8 "0.17684" f31 F)) - (bcStrings (8 "-1.0404" f32 F)) - (bcStrings (8 "-2.0029" f33 F)) - (bcStrings (8 "-2.475" f34 F)) - (bcStrings (8 "-2.3511" f35 F)) - (bcStrings (8 "-1.6741" f36 F)) - (bcStrings (8 "3" f37 F)) - (bcStrings (8 "2.6427" f38 F)) - (bcStrings (8 "1.6309" f39 F)) - (bcStrings (8 "0.21221" f40 F)) - (bcStrings (8 "-1.2484" f41 F)) - (bcStrings (8 "-2.2034" f42 F)) - (bcStrings (8 "-2.97" f43 F)) - (bcStrings (8 "-2.8094" f44 F)) - (bcStrings (8 "-1.9809" f45 F)) - (bcStrings (8 "3.5" f46 F)) - (bcStrings (8 "3.1715" f47 F)) - (bcStrings (8 "1.8611" f48 F)) - (bcStrings (8 "0.24458" f49 F)) - (bcStrings (8 "-1.4565" f50 F)) - (bcStrings (8 "-2.864" f51 F)) - (bcStrings (8 "-3.265" f52 F)) - (bcStrings (8 "-3.2776" f53 F)) - (bcStrings (8 "-2.2878" f54 F)) - (bcStrings (8 "4.04" f55 F)) - (bcStrings (8 "3.5103" f56 F)) - (bcStrings (8 "2.0612" f57 F)) - (bcStrings (8 "0.28595" f58 F)) - (bcStrings (8 "-1.6946" f59 F)) - (bcStrings (8 "-3.2046" f60 F)) - (bcStrings (8 "-3.96" f61 F)) - (bcStrings (8 "-3.7958" f62 F)) - (bcStrings (8 "-2.6146" f63 F)) - (bcStrings (8 "4.5" f64 F)) - (bcStrings (8 "3.9391" f65 F)) - (bcStrings (8 "2.4314" f66 F)) - (bcStrings (8 "0.31632" f67 F)) - (bcStrings (8 "-1.8627" f68 F)) - (bcStrings (8 "-3.6351" f69 F)) - (bcStrings (8 "-4.455" f70 F)) - (bcStrings (8 "-4.2141" f71 F)) - (bcStrings (8 "-2.9314" f72 F)) - (bcStrings (8 "5.04" f73 F)) - (bcStrings (8 "4.3879" f74 F)) - (bcStrings (8 "2.7515" f75 F)) - (bcStrings (8 "0.35369" f76 F)) - (bcStrings (8 "-2.0707" f77 F)) - (bcStrings (8 "-4.0057" f78 F)) - (bcStrings (8 "-4.97" f79 F)) - (bcStrings (8 "-4.6823" f80 F)) - (bcStrings (8 "-3.2382" f81 F)) - (bcStrings (8 "5.505" f82 F)) - (bcStrings (8 "4.8367" f83 F)) - (bcStrings (8 "2.9717" f84 F)) - (bcStrings (8 "0.38505" f85 F)) - (bcStrings (8 "-2.2888" f86 F)) - (bcStrings (8 "-4.4033" f87 F)) - (bcStrings (8 "-5.445" f88 F)) - (bcStrings (8 "-5.1405" f89 F)) - (bcStrings (8 "-3.595" f90 F)) - (bcStrings (8 "6" f91 F)) - (bcStrings (8 "5.2755" f92 F)) - (bcStrings (8 "3.2418" f93 F)) - (bcStrings (8 "0.42442" f94 F)) - (bcStrings (8 "-2.4769" f95 F)) - (bcStrings (8 "-4.8169" f96 F)) - (bcStrings (8 "-5.93" f97 F)) - (bcStrings (8 "-5.6387" f98 F)) - (bcStrings (8 "-3.9319" f99 F))) - htMakeDoneButton('"Continue",'e02dcfColdGen) - htpSetProperty(page,'mx,mx) - htpSetProperty(page,'my,my) - htpSetProperty(page,'nxest,nxest) - htpSetProperty(page,'nyest,nyest) - htpSetProperty(page,'lwrk,lwrk) - htpSetProperty(page,'liwrk,liwrk) - htpSetProperty(page,'s,s) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -e02dcfColdGen htPage == - mx := htpProperty(htPage,'mx) - my := htpProperty(htPage,'my) - nxest := htpProperty(htPage,'nxest) - nyest := htpProperty(htPage,'nyest) - lwrk := htpProperty(htPage,'lwrk) - liwrk := htpProperty(htPage,'liwrk) - s := htpProperty(htPage,'s) - cold := '"c" - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - for i in 1..(mx*my) repeat - end := STRCONC((first y).1," ") - y := rest y - fList := [end,:fList] - fstring := bcwords2liststring fList - for i in 1..my repeat - mid := STRCONC ((first y).1," ") - y := rest y - ylist := [mid,:ylist] - ystring := bcwords2liststring ylist - while y repeat - start := STRCONC ((first y).1," ") - y := rest y - xlist := [start,:xlist] - xstring := bcwords2liststring xlist - -- additional entries needed to get it running - -- but as Start = c they are not used - prefix := STRCONC('"e02dcf(_"",cold,"_",",STRINGIMAGE mx,", [",xstring,"],") - prefix := STRCONC(prefix,STRINGIMAGE my,",[",ystring,"],[",fstring,"], ") - prefix := STRCONC(prefix,STRINGIMAGE s,", ",STRINGIMAGE nxest,", ") - prefix := STRCONC(prefix,STRINGIMAGE nyest,", ",STRINGIMAGE lwrk,", ") - prefix := STRCONC(prefix,STRINGIMAGE liwrk,",0,new(1,", STRINGIMAGE nxest,",0.0)$MATRIX DFLOAT,") - prefix := STRCONC(prefix,"0,new(1,", STRINGIMAGE nyest,",0.0)$MATRIX DFLOAT,") - end := STRCONC("new(1,", STRINGIMAGE lwrk,",0.0)$MATRIX DFLOAT,[[0 for i in 1..") - end := STRCONC(end,STRINGIMAGE liwrk,"]]::Matrix Integer,",STRINGIMAGE ifail,")") - linkGen STRCONC(prefix,end) - - -e02ddf() == - htInitPage('"E02DDF - Least-squares surface fit by bicubic splines with automatic knot placement, scattered data",nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXe02ddf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02ddf| '|NagFittingPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "Determines a bicubic spline approximation to a set of scattered") - (text . " points ( \htbitmap{xr},\htbitmap{yr}, ") - (text . "\htbitmap{fr})") - (text . "with weights \htbitmap{wr}, for r = 1,2,...,m. ") - (text . "The knots \htbitmap{lamdai}, for i = 1,2,...,") - (text . "\htbitmap{nx} and \htbitmap{mui}, for ") - (text . "i = 1,2,...,\htbitmap{ny} are chosen by the routine ") - (text . ", but a single parameter S must be specified to control the ") - (text . "trade-off between closeness of fit and smoothness of fit. This ") - (text . "affects the number of knots required by the spline, which is ") - (text . "given in the B-spline representation \htbitmap{e02daf}") - (text . "\newline \menuitemstyle{}\tab{2} \newline ") - (text . "Number of data points {\it m}: ") - (text . "\newline\tab{2} ") - (bcStrings (6 30 m PI)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") - (text . "Over-estimate of \htbitmap{nx} of knots \lambda of the ") - (text . "computed spline, {\it nxest}: \newline\tab{2} ") - (bcStrings (6 14 nxest PI)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") - (text . "Over-estimate of \htbitmap{ny} of knots \mu of the computed ") - (text . "spline, {\it nyest}: \newline\tab{2} ") - (bcStrings (6 14 nyest PI)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} \newline ") - (text . "Smoothing factor {\it s}: ") - (text . "\newline\tab{2} ") - (bcStrings (6 "10" s F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Start value: ") - (radioButtons start - ("" " Cold Start - no values needed for {\it nx,ny,lamda,wrk,iwrk}" cold) - ("" " Warm Start - uses knots found in a previous call" warm)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'e02ddfSolve) - htShowPage() - -e02ddfSolve htPage == - m := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) - objValUnwrap htpLabelSpadValue(htPage, 'm) - nxest := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nxest) - objValUnwrap htpLabelSpadValue(htPage, 'nxest) - nyest := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nyest) - objValUnwrap htpLabelSpadValue(htPage, 'nyest) - u := nxest - 4 - v := nyest - 4 - wlist := [u,v] - w := APPLY ('MAX, wlist) - lwrk := (7*u*v + 25*w)*(w + 1) + 2*(u + v + 4*m) + 23*w + 56 - liwrk := m + 2*(nxest - 7)*(nyest - 7) - s := htpLabelInputString(htPage,'s) - initial := htpButtonValue(htPage,'start) - start := - initial = 'cold => '1 - '2 - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - (m = 30 and start = 1) => e02ddfDefaultSolve (htPage,nxest,nyest,lwrk,liwrk,s,ifail) - start = 1 => e02ddfColdSolve (htPage,m,nxest,nyest,lwrk,liwrk,s,ifail) - -- need to change as only wrk(1) is required - labelList := - "append"/[f(i) for i in 1..m] where f(i) == - prefix := ('"\newline \tab{2} ") - middle := ('"\tab{17} ") - post := ('"\tab{32} ") - end := ('"\tab{47} ") - xnam := INTERN STRCONC ('"x",STRINGIMAGE i) - ynam := INTERN STRCONC ('"y",STRINGIMAGE i) - fnam := INTERN STRCONC ('"f",STRINGIMAGE i) - wnam := INTERN STRCONC ('"w",STRINGIMAGE i) - [['text,:prefix],['bcStrings,[8, 0.0, xnam, 'F]], - ['text,:middle],['bcStrings,[8, 0.0, ynam, 'F]], - ['text,:post],['bcStrings,[8, 0.0, fnam, 'F]], - ['text,:end],['bcStrings,[8, 0.0, wnam, 'F]]] - lamdaList := - "append"/[g(i) for i in 1..nxest] where g(i) == - lnam := INTERN STRCONC ('"l",STRINGIMAGE i) - [['bcStrings,[8, 0.0, lnam, 'F]]] - prefix := ('"\blankline \menuitemstyle{} \tab{2} Values of Lamda: \newline") - lamdaList := [['text,:prefix],:lamdaList] - muList := - "append"/[h(i) for i in 1..nyest] where h(i) == - mnam := INTERN STRCONC ('"m",STRINGIMAGE i) - [['bcStrings,[8, 0.0, mnam, 'F]]] - prefix := ('"\blankline \menuitemstyle{} \tab{2} Values of Mu: \newline") - muList := [['text,:prefix],:muList] - prefix := ('"\blankline \menuitemstyle{} \tab{2} Value of nx: \newline \tab{2}") - nxList := [['text,:prefix],['bcStrings,[8, 10, 'nx, 'PI]]] - prefix := ('"\blankline \menuitemstyle{} \tab{2} Value of ny: \newline \tab{2}") - nyList := [['text,:prefix],['bcStrings,[8, 9, 'ny, 'PI]]] - prefix := ('"\blankline \menuitemstyle{} \tab{2} Value of WRK(1): \newline \tab{2}") - wList := [['text,:prefix],['bcStrings,[8, 0.0, 'wone, 'F]]] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :labelList,:lamdaList,:muList,:nxList,:nyList,:wList] - page := htInitPage('"E02DDF - Least-squares surface fit by bicubic splines with automatic knot placement, scattered data",nil) - htSay '"\menuitemstyle{}\tab{2} Values of \space{1} " - htSay '"\htbitmap{xr}: \tab{15} \menuitemstyle{}\tab{17} " - htSay '"Values of \space{1} \htbitmap{yr}: \tab{30}" - htSay '"\menuitemstyle{}\tab{32} Values of \space{1} " - htSay '"\htbitmap{fr}: \tab{45} \menuitemstyle{} " - htSay '"\tab{47} Values of \htbitmap{wr}:" - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'e02ddfWarmGen) - htpSetProperty(page,'m,m) - htpSetProperty(page,'nxest,nxest) - htpSetProperty(page,'nyest,nyest) - htpSetProperty(page,'lwrk,lwrk) - htpSetProperty(page,'liwrk,liwrk) - htpSetProperty(page,'s,s) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - - - -e02ddfColdSolve(htPage,m,nxest,nyest,lwrk,liwrk,s,ifail) == - labelList := - "append"/[f(i) for i in 1..m] where f(i) == - prefix := ('"\newline \tab{2} ") - middle := ('"\tab{17} ") - post := ('"\tab{32} ") - end := ('"\tab{47} ") - xnam := INTERN STRCONC ('"x",STRINGIMAGE i) - ynam := INTERN STRCONC ('"y",STRINGIMAGE i) - fnam := INTERN STRCONC ('"f",STRINGIMAGE i) - wnam := INTERN STRCONC ('"w",STRINGIMAGE i) - [['text,:prefix],['bcStrings,[8, 0.0, xnam, 'F]], - ['text,:middle],['bcStrings,[8, 0.0, ynam, 'F]], - ['text,:post],['bcStrings,[8, 0.0, fnam, 'F]], - ['text,:end],['bcStrings,[8, 0.0, wnam, 'F]]] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :labelList] - page := htInitPage('"E02DDF - Least-squares surface fit by bicubic splines with automatic knot placement, scattered data",nil) - htSay '"\menuitemstyle{}\tab{2} Values of \space{1} " - htSay '"\htbitmap{xr}: \tab{15} \menuitemstyle{}\tab{17} " - htSay '"Values of \space{1} \htbitmap{yr}: \tab{30}" - htSay '"\menuitemstyle{}\tab{32} Values of \space{1} " - htSay '"\htbitmap{fr}: \tab{44} \menuitemstyle{} " - htSay '"\tab{46} Values of \htbitmap{wr}:" - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'e02ddfColdGen) - htpSetProperty(page,'m,m) - htpSetProperty(page,'nxest,nxest) - htpSetProperty(page,'nyest,nyest) - htpSetProperty(page,'lwrk,lwrk) - htpSetProperty(page,'liwrk,liwrk) - htpSetProperty(page,'s,s) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -e02ddfDefaultSolve (htPage,nxest,nyest,lwrk,liwrk,s,ifail) == - m := 30 - page := htInitPage('"E02DDF - Least-squares surface fit by bicubic splines with automatic knot placement, scattered data",nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Values of \htbitmap{xr}:") - (text . "\tab{15} \menuitemstyle{} \tab{17} Values of ") - (text . "\htbitmap{yr}: \tab{30} \menuitemstyle{} \tab{32} ") - (text . "Values of \htbitmap{fr}: \tab{44} \menuitemstyle{} ") - (text . "\tab{46} Values of \htbitmap{wr}:") - (text . "\newline \tab{2} ") - (bcStrings (8 "11.16" x1 F)) - (text . "\tab{17}") - (bcStrings (8 "1.24" y1 F)) - (text . "\tab{32}") - (bcStrings (8 "22.15" f1 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w1 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "12.85" x2 F)) - (text . "\tab{17}") - (bcStrings (8 "3.06" y2 F)) - (text . "\tab{32}") - (bcStrings (8 "22.11" f2 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w2 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "19.85" x3 F)) - (text . "\tab{17}") - (bcStrings (8 "10.72" y3 F)) - (text . "\tab{32}") - (bcStrings (8 "7.97" f3 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w3 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "19.72" x4 F)) - (text . "\tab{17}") - (bcStrings (8 "1.39" y4 F)) - (text . "\tab{32}") - (bcStrings (8 "16.83" f4 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w4 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "15.91" x5 F)) - (text . "\tab{17}") - (bcStrings (8 "7.74" y5 F)) - (text . "\tab{32}") - (bcStrings (8 "15.30" f5 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w5 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "0" x6 F)) - (text . "\tab{17}") - (bcStrings (8 "20" y6 F)) - (text . "\tab{32}") - (bcStrings (8 "34.6" f6 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w6 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "20.87" x7 F)) - (text . "\tab{17}") - (bcStrings (8 "20" y7 F)) - (text . "\tab{32}") - (bcStrings (8 "5.74" f7 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w7 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "3.45" x8 F)) - (text . "\tab{17}") - (bcStrings (8 "12.78" y8 F)) - (text . "\tab{32}") - (bcStrings (8 "41.24" f8 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w8 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "14.26" x9 F)) - (text . "\tab{17}") - (bcStrings (8 "17.87" y9 F)) - (text . "\tab{32}") - (bcStrings (8 "10.74" f9 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w9 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "17.43" x10 F)) - (text . "\tab{17}") - (bcStrings (8 "3.46" y10 F)) - (text . "\tab{32}") - (bcStrings (8 "18.60" f10 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w10 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "22.8" x11 F)) - (text . "\tab{17}") - (bcStrings (8 "12.39" y11 F)) - (text . "\tab{32}") - (bcStrings (8 "5.47" f11 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w11 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "7.58" x12 F)) - (text . "\tab{17}") - (bcStrings (8 "1.98" y12 F)) - (text . "\tab{32}") - (bcStrings (8 "29.87" f12 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w12 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "25" x13 F)) - (text . "\tab{17}") - (bcStrings (8 "11.87" y13 F)) - (text . "\tab{32}") - (bcStrings (8 "4.4" f13 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w13 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "0" x14 F)) - (text . "\tab{17}") - (bcStrings (8 "0" y14 F)) - (text . "\tab{32}") - (bcStrings (8 "58.2" f14 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w14 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "9.66" x15 F)) - (text . "\tab{17}") - (bcStrings (8 "20" y15 F)) - (text . "\tab{32}") - (bcStrings (8 "4.73" f15 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w15 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "5.22" x16 F)) - (text . "\tab{17}") - (bcStrings (8 "14.66" y16 F)) - (text . "\tab{32}") - (bcStrings (8 "40.36" f16 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w16 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "17.25" x17 F)) - (text . "\tab{17}") - (bcStrings (8 "19.57" y17 F)) - (text . "\tab{32}") - (bcStrings (8 "6.43" f17 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w17 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "25" x18 F)) - (text . "\tab{17}") - (bcStrings (8 "3.87" y18 F)) - (text . "\tab{32}") - (bcStrings (8 "8.74" f18 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w18 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "12.13" x19 F)) - (text . "\tab{17}") - (bcStrings (8 "10.79" y19 F)) - (text . "\tab{32}") - (bcStrings (8 "13.71" f19 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w19 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "22.23" x20 F)) - (text . "\tab{17}") - (bcStrings (8 "6.21" y20 F)) - (text . "\tab{32}") - (bcStrings (8 "10.25" f20 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w20 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "11.52" x21 F)) - (text . "\tab{17}") - (bcStrings (8 "8.53" y21 F)) - (text . "\tab{32}") - (bcStrings (8 "15.74" f21 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w21 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "15.2" x22 F)) - (text . "\tab{17}") - (bcStrings (8 "0" y22 F)) - (text . "\tab{32}") - (bcStrings (8 "21.6" f22 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w22 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "7.54" x23 F)) - (text . "\tab{17}") - (bcStrings (8 "10.69" y23 F)) - (text . "\tab{32}") - (bcStrings (8 "19.31" f23 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w23 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "17.32" x24 F)) - (text . "\tab{17}") - (bcStrings (8 "13.78" y24 F)) - (text . "\tab{32}") - (bcStrings (8 "12.11" f24 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w24 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "2.14" x25 F)) - (text . "\tab{17}") - (bcStrings (8 "15.03" y25 F)) - (text . "\tab{32}") - (bcStrings (8 "53.1" f25 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w25 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "0.51" x26 F)) - (text . "\tab{17}") - (bcStrings (8 "8.37" y26 F)) - (text . "\tab{32}") - (bcStrings (8 "49.43" f26 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w26 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "22.69" x27 F)) - (text . "\tab{17}") - (bcStrings (8 "19.63" y27 F)) - (text . "\tab{32}") - (bcStrings (8 "3.25" f27 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w27 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "5.47" x28 F)) - (text . "\tab{17}") - (bcStrings (8 "17.13" y28 F)) - (text . "\tab{32}") - (bcStrings (8 "28.63" f28 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w28 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "21.67" x29 F)) - (text . "\tab{17}") - (bcStrings (8 "14.36" y29 F)) - (text . "\tab{32}") - (bcStrings (8 "5.52" f29 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w29 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "3.31" x30 F)) - (text . "\tab{17}") - (bcStrings (8 "0.33" y30 F)) - (text . "\tab{32}") - (bcStrings (8 "44.08" f30 F)) - (text . "\tab{47}") - (bcStrings (8 "1" w30 F)) - (text . "\blankline")) - htMakeDoneButton('"Continue",'e02ddfColdGen) - htpSetProperty(page,'m,m) - htpSetProperty(page,'nxest,nxest) - htpSetProperty(page,'nyest,nyest) - htpSetProperty(page,'lwrk,lwrk) - htpSetProperty(page,'liwrk,liwrk) - htpSetProperty(page,'s,s) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -e02ddfColdGen htPage == - m := htpProperty(htPage,'m) - nxest := htpProperty(htPage,'nxest) - nyest := htpProperty(htPage,'nyest) - lwrk := htpProperty(htPage,'lwrk) - liwrk := htpProperty(htPage,'liwrk) - s := htpProperty(htPage,'s) - cold := '"c" - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - while y repeat - end := STRCONC ((first y).1," ") - y := rest y - right := STRCONC ((first y).1," ") - y := rest y - mid := STRCONC ((first y).1," ") - y := rest y - left := STRCONC ((first y).1," ") - y := rest y - xlist := [left,:xlist] - ylist := [mid,:ylist] - flist := [right,:flist] - wlist := [end,:wlist] - xstring := bcwords2liststring xlist - ystring := bcwords2liststring ylist - fstring := bcwords2liststring flist - wstring := bcwords2liststring wlist - -- additional entries nx,ny,lamda,mu,wrk needed to get it running - -- but they are just set to 0.0 - prefix := STRCONC('"e02ddf(_"",cold,"_",",STRINGIMAGE m,", [",xstring,"],[") - prefix := STRCONC(prefix,ystring,"],[",fstring,"],[",wstring,"], ") - prefix := STRCONC(prefix,STRINGIMAGE s,", ",STRINGIMAGE nxest,", ") - prefix := STRCONC(prefix,STRINGIMAGE nyest,", ",STRINGIMAGE lwrk,", ") - prefix := STRCONC(prefix,STRINGIMAGE liwrk,", 0,") - prefix := STRCONC(prefix,"new(1,", STRINGIMAGE nxest,",0.0)$MATRIX DFLOAT,0,") - prefix := STRCONC(prefix,"new(1,", STRINGIMAGE nyest,",0.0)$MATRIX DFLOAT,") - prefix := STRCONC(prefix,"new(1,", STRINGIMAGE lwrk,",0.0)$MATRIX DFLOAT,") --- prefix := STRCONC(prefix,"[[0.0 for i in 1..", STRINGIMAGE nxest,"]],0,") --- prefix := STRCONC(prefix,"[[0.0 for i in 1..", STRINGIMAGE nyest,"]],") --- prefix := STRCONC(prefix,"[[0.0 for i in 1..", STRINGIMAGE lwrk,"]],") - prefix := STRCONC(prefix,STRINGIMAGE ifail,")") - linkGen prefix - -e02ddfWarmGen htPage == - m := htpProperty(htPage,'m) - nxest := htpProperty(htPage,'nxest) - nyest := htpProperty(htPage,'nyest) - lwrk := htpProperty(htPage,'lwrk) - liwrk := htpProperty(htPage,'liwrk) - s := htpProperty(htPage,'s) - warm := '"w" - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - wrk := (first y).1 - y := rest y - for i in 1..lwrk repeat - wrkList := ['"0.0 ",:wrkList] - wrkList := [wrk,:wrkList] - wrkstring := bcwords2liststring wrkList - ny := STRCONC((first y).1," ") - y := rest y - nx := STRCONC((first y).1," ") - y := rest y - for i in 1..nyest repeat - mu := STRCONC ((first y).1, " ") - y := rest y - muList := [mu,:muList] - mustring := bcwords2liststring muList - for i in 1..nxest repeat - lam := STRCONC ((first y).1, " ") - y := rest y - lamList := [lam,:lamList] - lamstring := bcwords2liststring lamList - while y repeat - end := STRCONC ((first y).1," ") - y := rest y - right := STRCONC ((first y).1," ") - y := rest y - mid := STRCONC ((first y).1," ") - y := rest y - left := STRCONC ((first y).1," ") - y := rest y - xlist := [left,:xlist] - ylist := [mid,:ylist] - flist := [right,:flist] - wlist := [end,:wlist] - xstring := bcwords2liststring xlist - ystring := bcwords2liststring ylist - fstring := bcwords2liststring flist - wstring := bcwords2liststring wlist - -- additional entries nx,ny,lamda,mu,wrk needed to get it running - -- but they are just set to 0.0 - prefix := STRCONC('"e02ddf(_"",warm,"_",",STRINGIMAGE m,", [",xstring,"],[") - prefix := STRCONC(prefix,ystring,"],[",fstring,"],[",wstring,"], ") - prefix := STRCONC(prefix,STRINGIMAGE s,", ",STRINGIMAGE nxest,", ") - prefix := STRCONC(prefix,STRINGIMAGE nyest,", ",STRINGIMAGE lwrk,", ") - prefix := STRCONC(prefix,STRINGIMAGE liwrk,", ",nx,",[",lamstring,"],",ny) - prefix := STRCONC(prefix,",[",mustring,"],[",wrkstring,"],") - prefix := STRCONC(prefix,STRINGIMAGE ifail,")") - linkGen prefix - -e02zaf() == - htInitPage('"E02ZAF - Sort 2-D sata into panels for fitting bicubic splines",nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXe02zaf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e02zaf| '|NagFittingPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "Sorts the set of points {\em (\htbitmap{xr},") - (text . "\htbitmap{yr})} into panels defined by \space{1}") - (text . "\htbitmap{px} -8 points \htbitmap{lamdai} ") - (text . "on the x-axis and \space{1}\htbitmap{py}-8 points ") - (text . "\htbitmap{muj} on the y axis. The points are ordered ") - (text . "so that all points in a panel occur before data in succeeding ") - (text . "panels. Within a panel, the points maintain their original ") - (text . "order. ") - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} \newline ") - (text . "Number of points to be sorted to be sorted {\it m}: ") - (text . "\newline\tab{2} ") - (bcStrings (6 10 m PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "\newline Intercepts + 8 on x axis {\em px}:") - (text . "\tab{32} \menuitemstyle{}\tab{34}") - (text . "Intercepts + 8 on y axis {\em py}:") - (text . "\newline\tab{2} ") - (bcStrings (6 9 px PI)) - (text . "\tab{34} ") - (bcStrings (6 10 py PI)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} \newline ") - (text . "Dimension of point {\it npoint}: ") - (text . "\newline\tab{2} ") - (bcStrings (6 45 npoint PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'e02zafSolve) - htShowPage() - -e02zafSolve htPage == - m := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) - objValUnwrap htpLabelSpadValue(htPage, 'm) - px := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'px) - objValUnwrap htpLabelSpadValue(htPage, 'px) - py := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'py) - objValUnwrap htpLabelSpadValue(htPage, 'py) - npoint := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'npoint) - objValUnwrap htpLabelSpadValue(htPage, 'npoint) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - ((m = '10 and px = '9) and py = '10) => e02zafDefaultSolve(htPage,npoint,ifail) - labelList := - "append"/[fxy(i) for i in 1..m] where fxy(i) == - prefix := ('"\newline \tab{2} ") - middle := ('"\tab{32} ") - lnam := INTERN STRCONC ('"x",STRINGIMAGE i) - cnam := INTERN STRCONC ('"y",STRINGIMAGE i) - [['text,:prefix],['bcStrings,[8, 0.0, lnam, 'F]], - ['text,:middle],['bcStrings,[8, 0.0, cnam, 'F]]] - lamList := - "append"/[flam(i) for i in 5..(px-4)] where flam(i) == - lnam := INTERN STRCONC ('"l",STRINGIMAGE i) - [['bcStrings,[8, 0.0, lnam, 'F]]] - prefix := ('"\blankline \menuitemstyle{} \tab{2} {\it \lambda(5) to ") - prefix := STRCONC(prefix,"\lambda(px-4)}: \newline \tab{2} ") - lamList := [['text,:prefix],:lamList] - muList := - "append"/[fmu(i) for i in 5..(py-4)] where fmu(i) == - mnam := INTERN STRCONC ('"m",STRINGIMAGE i) - [['bcStrings,[8, 0.0, mnam, 'F]]] - prefix := ('"\blankline \menuitemstyle{} \tab{2} {\it \mu(5) to \mu(py-4)}: ") - prefix := STRCONC(prefix,"\newline \tab{2} ") - muList := [['text,:prefix],:muList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :labelList,:lamList,:muList] - page := htInitPage('"E02ZAF - Sort 2-D sata into panels for fitting bicubic splines",nil) - htSay '"\menuitemstyle{}\tab{2} {\it x(m)}: " - htSay '"\tab{30} \menuitemstyle{}\tab{32} {\it y(m)}: " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'e02zafGen) - htpSetProperty(page,'m,m) - htpSetProperty(page,'px,px) - htpSetProperty(page,'py,py) - htpSetProperty(page,'npoint,npoint) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -e02zafDefaultSolve (htPage,npoint,ifail) == - m := '10 - px := '9 - py := '10 - page := htInitPage('"E02ZAF - Sort 2-D sata into panels for fitting bicubic splines",nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} {\it x(m)}:") - (text . "\tab{30} \menuitemstyle{} \tab{32} {\it y(m)}:") - (text . "\newline \tab{2} ") - (bcStrings (8 "0.00" x1 F)) - (text . "\tab{32}") - (bcStrings (8 "0.77" y1 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "0.70" x2 F)) - (text . "\tab{32}") - (bcStrings (8 "1.06" y2 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "1.44" x3 F)) - (text . "\tab{32}") - (bcStrings (8 "0.33" y3 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "0.21" x4 F)) - (text . "\tab{32}") - (bcStrings (8 "0.44" y4 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "1.01" x5 F)) - (text . "\tab{32}") - (bcStrings (8 "0.50" y5 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "1.84" x6 F)) - (text . "\tab{32}") - (bcStrings (8 "0.02" y6 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "0.71" x7 F)) - (text . "\tab{32}") - (bcStrings (8 "1.95" y7 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "1.00" x8 F)) - (text . "\tab{32}") - (bcStrings (8 "1.20" y8 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "0.54" x9 F)) - (text . "\tab{32}") - (bcStrings (8 "0.04" y9 F)) - (text . "\newline \tab{2} ") - (bcStrings (8 "1.531" x10 F)) - (text . "\tab{32}") - (bcStrings (8 "0.18" y10 F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} {\it \lambda(5) to \lambda(px-4)}:") - (text . "\newline \tab{2}") - (bcStrings (8 "1.00" l5 F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} {\it \mu(5) to \mu(py-4)}:") - (text . "\newline \tab{2}") - (bcStrings (8 "0.80" mu5 F)) - (bcStrings (8 "1.20" mu6 F)) - (text . "\blankline ")) - htMakeDoneButton('"Continue",'e02zafGen) - htpSetProperty(page,'m,m) - htpSetProperty(page,'px,px) - htpSetProperty(page,'py,py) - htpSetProperty(page,'npoint,npoint) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -e02zafGen htPage == - m := htpProperty(htPage,'m) - px := htpProperty(htPage,'px) - py := htpProperty(htPage,'py) - npoint := htpProperty(htPage,'npoint) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - nadres := (px-7)*(py-7) - -- mu - for i in 1..4 repeat - muList := ['"0 ",:muList] - for i in 5..(py-4) repeat - right := STRCONC ((first y).1," ") - y := rest y - muList := [right,:muList] - for i in (py-3)..py repeat - muList := ['"0 ",:muList] - mustring := bcwords2liststring muList - -- lamda - for i in 1..4 repeat - lamList := ['"0 ",:lamList] - for i in 5..(px-4) repeat - right := STRCONC ((first y).1," ") - y := rest y - lamList := [right,:lamList] - for i in (px-3)..px repeat - lamList := ['"0 ",:lamList] - lamstring := bcwords2liststring lamList - -- x & y - while y repeat - right := STRCONC ((first y).1," ") - y := rest y - left := STRCONC ((first y).1," ") - y := rest y - xlist := [left,:xlist] - ylist := [right,:ylist] - xstring := bcwords2liststring xlist - ystring := bcwords2liststring ylist - prefix := STRCONC('"e02zaf(",STRINGIMAGE px,", ",STRINGIMAGE py,",[") - prefix := STRCONC(prefix,lamstring,"],[",mustring,"], ",STRINGIMAGE m,", [") - prefix := STRCONC(prefix,xstring,"],[",ystring,"], ",STRINGIMAGE npoint,", ") - prefix := STRCONC(prefix,STRINGIMAGE nadres,", ",STRINGIMAGE ifail,")") - linkGen prefix - - - -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/nag-e04.boot b/src/interp/nag-e04.boot new file mode 100644 index 00000000..e20eb98e --- /dev/null +++ b/src/interp/nag-e04.boot @@ -0,0 +1,2500 @@ +-- 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. + + +)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() + + +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,")") + + + + diff --git a/src/interp/nag-e04.boot.pamphlet b/src/interp/nag-e04.boot.pamphlet deleted file mode 100644 index 13113010..00000000 --- a/src/interp/nag-e04.boot.pamphlet +++ /dev/null @@ -1,2522 +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. - -@ -<<*>>= -<> - -)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() - - -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-f01.boot b/src/interp/nag-f01.boot new file mode 100644 index 00000000..bbb511b6 --- /dev/null +++ b/src/interp/nag-f01.boot @@ -0,0 +1,2232 @@ +-- 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. + + +)package "BOOT" + +f01brf() == + htInitPage("F01BRF - LU factorization of real sparse matrix",nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\windowlink{Manual Page}{manpageXXf01brf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f01brf| '|NagMatrixOperationsPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "Factorizes a real sparse matrix A of order n. The routine forms ") + (text . "the {\it LU} factorization of the entire matrix, or ,") + (text . "optionally, first permutes the matrix to block lower ") + (text . "triangular form and then only factorizes the diagonal block. ") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the order {\em n} of the matrix A ") + (text . "\htbitmap{great=} 1:") + (text . "\newline\tab{2} ") + (bcStrings (8 6 n PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Number of non-zero elements {\it nz}:") + (text . "\tab{32} \menuitemstyle{}\tab{34}") + (text . "{\it pivot}:") + (text . "\newline \tab{2} ") + (bcStrings (8 15 nz PI)) + (text . "\tab{34} ") + (bcStrings (8 "0.1" pivot PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Dimension of A & ICN {\it licn}:") + (text . "\tab{32} \menuitemstyle{}\tab{34}") + (text . "Dimension of IRN {\it lirn}:") + (text . "\newline \tab{2} ") + (bcStrings (6 150 licn PI)) + (text . "\tab{34} ") + (bcStrings (6 75 lirn PI)) + (text . "\blankline") + (text . "\menuitemstyle{}\tab{2} Grow value:") + (radioButtons grow + ("" " True" gr_true) + ("" " False" gr_false)) + (text . "\blankline") + (text . "\menuitemstyle{}\tab{2} Lblock value:") + (radioButtons lblock + ("" " True" lb_true) + ("" " False" lb_false)) + (text . "\blankline ") + (text . "\newline \tab{2} ") + (text . "Ifail is input in three components: ") + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "{\it a} ") + (radioButtons afail + ("" " 0, hard failure" azero) + ("" " 1, soft failure" aone)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "{\it b} ") + (radioButtons bfail + ("" " 1, print error messages" bone) + ("" " 0, suppress error messages" bzero)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "{\it c} ") + (radioButtons cfail + ("" " 1, print warning messages" cone) + ("" " 0, suppress warning messages" czero))) + htMakeDoneButton('"Continue", 'f01brfSolve) + htShowPage() + +f01brfSolve htPage == + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + nz := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nz) + objValUnwrap htpLabelSpadValue(htPage, 'nz) + licn := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'licn) + objValUnwrap htpLabelSpadValue(htPage, 'licn) + lirn := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lirn) + objValUnwrap htpLabelSpadValue(htPage, 'lirn) + pivot := htpLabelInputString(htPage, 'pivot) + gr := htpButtonValue(htPage,'grow) + grow := + gr = 'gr_true => '"true" + '"false" + lb := htpButtonValue(htPage,'lblock) + lblock := + lb = 'lb_true => '"true" + '"false" + aerror := htpButtonValue(htPage,'afail) + afail := + aerror = 'azero => '0 + '1 + berror := htpButtonValue(htPage,'bfail) + bfail := + berror = 'bone => '1 + '0 + cerror := htpButtonValue(htPage,'cfail) + cfail := + cerror = 'cone => '1 + '0 + ifail := 100*cfail + 10*bfail + afail + ((n = '6 and nz = '15) and (licn = '150 and lirn = '75)) + => f01brfDefaultSolve(htPage,pivot,grow,lblock,ifail) + labelList := + "append"/[f(i) for i in 1..nz] where f(i) == + prefix := ('"\newline \tab{2} ") + anam := INTERN STRCONC ('"a",STRINGIMAGE i) + mid := ('"\tab{32} ") + rnam := INTERN STRCONC ('"irn",STRINGIMAGE i) + end := ('"\tab{42} ") + cnam := INTERN STRCONC ('"icn",STRINGIMAGE i) + [['text,:prefix],['bcStrings,[8, 0.0, anam, 'F]], + ['text,:mid],['bcStrings,[4, 0, rnam, 'PI]], + ['text,:end],['bcStrings,[4, 0, cnam, 'PI]]] + abortList := + [['bcStrings,[6, '"true", 'abortone, 'EM]], + ['bcStrings,[6, '"true", 'aborttwo, 'EM]], + ['bcStrings,[6, '"false", 'abortthree, 'EM]], + ['bcStrings,[6, '"true", 'abortfour, 'EM]]] + prefix := ('"\blankline \menuitemstyle{}\tab{2} Abort: ") + abortList := [['text,:prefix],:abortList] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain EM ($EmptyMode)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :labelList,:abortList] + page := htInitPage("F01BRF - LU factorization of real sparse matrix",nil) + htSay '"\menuitemstyle{}\tab{2} Non-zero elements of A: " + htSay '"\tab{30} \menuitemstyle{}\tab{32} Row: " + htSay '"\tab{40} \menuitemstyle{}\tab{42} Column: " + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'f01brfGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'nz,nz) + htpSetProperty(page,'licn,licn) + htpSetProperty(page,'lirn,lirn) + htpSetProperty(page,'pivot,pivot) + htpSetProperty(page,'grow,grow) + htpSetProperty(page,'lblock,lblock) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +f01brfDefaultSolve(htPage,pivot,grow,lblock,ifail) == + n := '6 + nz := '15 + licn := '150 + lirn := '75 + page := htInitPage("F01BRF - LU factorization of real sparse matrix",nil) + htMakePage '( + (domainConditions + (isDomain PI (Positive Integer)) + (isDomain EM $EmptyMode) + (isDomain F (Float))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Non-zero elements of A: ") + (text . "\tab{30} \menuitemstyle{}\tab{32} Row: ") + (text . "\tab{40} \menuitemstyle{}\tab{42} Column: ") + (text . "\newline \tab{2}") + (bcStrings (8 "5.0" a1 F)) + (text . "\tab{32} ") + (bcStrings (4 1 irn1 PI)) + (text . "\tab{42} ") + (bcStrings (4 1 icn1 PI)) + (text . "\newline \tab{2}") + (bcStrings (8 "2.0" a2 F)) + (text . "\tab{32} ") + (bcStrings (4 2 irn2 PI)) + (text . "\tab{42} ") + (bcStrings (4 2 icn2 PI)) + (text . "\newline \tab{2}") + (bcStrings (8 "-1.0" a3 F)) + (text . "\tab{32} ") + (bcStrings (4 2 irn3 PI)) + (text . "\tab{42} ") + (bcStrings (4 3 icn3 PI)) + (text . "\newline \tab{2}") + (bcStrings (8 "2.0" a4 F)) + (text . "\tab{32} ") + (bcStrings (4 2 irn4 PI)) + (text . "\tab{42} ") + (bcStrings (4 4 icn4 PI)) + (text . "\newline \tab{2}") + (bcStrings (8 "3.0" a5 F)) + (text . "\tab{32} ") + (bcStrings (4 3 irn5 PI)) + (text . "\tab{42} ") + (bcStrings (4 3 icn5 PI)) + (text . "\newline \tab{2}") + (bcStrings (8 "-2.0" a6 F)) + (text . "\tab{32} ") + (bcStrings (4 4 irn6 PI)) + (text . "\tab{42} ") + (bcStrings (4 1 icn6 PI)) + (text . "\newline \tab{2}") + (bcStrings (8 "1.0" a7 F)) + (text . "\tab{32} ") + (bcStrings (4 4 irn7 PI)) + (text . "\tab{42} ") + (bcStrings (4 4 icn7 PI)) + (text . "\newline \tab{2}") + (bcStrings (8 "1.0" a8 F)) + (text . "\tab{32} ") + (bcStrings (4 4 irn8 PI)) + (text . "\tab{42} ") + (bcStrings (4 5 icn8 PI)) + (text . "\newline \tab{2}") + (bcStrings (8 "-1.0" a9 F)) + (text . "\tab{32} ") + (bcStrings (4 5 irn9 PI)) + (text . "\tab{42} ") + (bcStrings (4 1 icn9 PI)) + (text . "\newline \tab{2}") + (bcStrings (8 "-1.0" a10 F)) + (text . "\tab{32} ") + (bcStrings (4 5 irn10 PI)) + (text . "\tab{42} ") + (bcStrings (4 4 icn10 PI)) + (text . "\newline \tab{2}") + (bcStrings (8 "2.0" a11 F)) + (text . "\tab{32} ") + (bcStrings (4 5 irn11 PI)) + (text . "\tab{42} ") + (bcStrings (4 5 icn11 PI)) + (text . "\newline \tab{2}") + (bcStrings (8 "-3.0" a12 F)) + (text . "\tab{32} ") + (bcStrings (4 5 irn12 PI)) + (text . "\tab{42} ") + (bcStrings (4 6 icn12 PI)) + (text . "\newline \tab{2}") + (bcStrings (8 "-1.0" a13 F)) + (text . "\tab{32} ") + (bcStrings (4 6 irn13 PI)) + (text . "\tab{42} ") + (bcStrings (4 1 icn13 PI)) + (text . "\newline \tab{2}") + (bcStrings (8 "-1.0" a14 F)) + (text . "\tab{32} ") + (bcStrings (4 6 irn14 PI)) + (text . "\tab{42} ") + (bcStrings (4 2 icn14 PI)) + (text . "\newline \tab{2}") + (bcStrings (8 "6.0" a15 F)) + (text . "\tab{32} ") + (bcStrings (4 6 irn15 PI)) + (text . "\tab{42} ") + (bcStrings (4 6 icn15 PI)) + (text . "\blankline ") + (text . "\menuitemstyle{} \tab{2} Abort :") + (bcStrings (8 "true" abort_one EM)) + (bcStrings (8 "true" abort_two EM)) + (bcStrings (8 "false" abort_three EM)) + (bcStrings (8 "true" abort_four EM))) + htMakeDoneButton('"Continue",'f01brfGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'nz,nz) + htpSetProperty(page,'licn,licn) + htpSetProperty(page,'lirn,lirn) + htpSetProperty(page,'pivot,pivot) + htpSetProperty(page,'grow,grow) + htpSetProperty(page,'lblock,lblock) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +f01brfGen htPage == + n := htpProperty(htPage,'n) + nz := htpProperty(htPage,'nz) + licn := htpProperty(htPage,'licn) + lirn := htpProperty(htPage,'lirn) + pivot := htpProperty(htPage,'pivot) + grow := htpProperty(htPage,'grow) + lblock := htpProperty(htPage,'lblock) + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + for i in 1..4 repeat + abort := STRCONC((first y).1," ") + y := rest y + abortList := [abort,:abortList] + astring := bcwords2liststring abortList + while y repeat + end := STRCONC ((first y).1," ") + y := rest y + mid := STRCONC ((first y).1," ") + y := rest y + top := STRCONC ((first y).1," ") + y := rest y + cList := [end,:cList] + rList := [mid,:rList] + matList := [top,:matList] + for i in 1..(licn-nz) repeat + cList := [:cList,'"0 "] + matList := [:matList,'"0 "] + for i in 1..(lirn-nz) repeat + rList := [:rList,'"0 "] + cstring := bcwords2liststring cList + rstring := bcwords2liststring rList + matstring := bcwords2liststring matList + prefix := STRCONC('"f01brf(",STRINGIMAGE n,", ",STRINGIMAGE nz,", ") + prefix := STRCONC(prefix,STRINGIMAGE licn,", ",STRINGIMAGE lirn,", ",pivot) + prefix := STRCONC(prefix,", ",lblock,", ",grow,", ",astring,",[",matstring) + prefix := STRCONC(prefix,"],[",rstring,"],[",cstring,"], ") + linkGen STRCONC(prefix,STRINGIMAGE ifail,")") + +f01bsf() == + htInitPage("F01BSF - LU factorization of real sparse matrix with known sparsity pattern",nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\windowlink{Manual Page}{manpageXXf01bsf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f01bsf| '|NagMatrixOperationsPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "Factorizes a real sparse matrix A of order n using the pivotal ") + (text . "sequence previously obtained by F01BRF when a matrix of the ") + (text . "same sparsity pattern was factorized. ") + (text . "\blankline ") + (text . "Read the input file to see the example program. ") + (text . "\spadpaste{)read f01bsf \bound{s0}} ") + (text . "\blankline") + (text . "\newline ")) + htShowPage() + +f01maf() == + htInitPage("F01MAF - \htbitmap{llt} factorization of real sparse symmetric positive-definite matrix",nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\windowlink{Manual Page}{manpageXXf01maf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f01maf| '|NagMatrixOperationsPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "Computes an incomplete Cholesky factorization of a real ") + (text . "sparse symmetric positive-definite matrix A of order n. ") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the order {\em n} of the matrix A ") + (text . "\htbitmap{great=} 1:") + (text . "\newline\tab{2} ") + (bcStrings (8 16 n PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Number of non-zero elements {\it nz}:") + (text . "\newline \tab{2} ") + (bcStrings (8 40 nz PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Dimension of A & ICN {\it licn}:") + (text . "\tab{32} \menuitemstyle{}\tab{34}") + (text . "Dimension of IRN {\it lirn}:") + (text . "\newline \tab{2} ") + (bcStrings (6 90 licn PI)) + (text . "\tab{34} ") + (bcStrings (6 50 lirn PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Tolerance {\it droptl}: ") + (text . "\tab{32} \menuitemstyle{}\tab{34}") + (text . "{\it densw}:") + (text . "\newline \tab{2} ") + (bcStrings (6 "0.1" droptl F)) + (text . "\tab{34} ") + (bcStrings (6 "0.8" densw F)) + (text . "\blankline ") + (text . "\newline \tab{2} ") + (text . "Ifail is input in three components: ") + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "{\it a} ") + (radioButtons afail + ("" " 0, hard failure" azero) + ("" " 1, soft failure" aone)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "{\it b} ") + (radioButtons bfail + ("" " 1, print error messages" bone) + ("" " 0, suppress error messages" bzero)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "{\it c} ") + (radioButtons cfail + ("" " 1, print warning messages" cone) + ("" " 0, suppress warning messages" czero))) + htMakeDoneButton('"Continue", 'f01mafSolve) + htShowPage() + +f01mafSolve htPage == + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + nz := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nz) + objValUnwrap htpLabelSpadValue(htPage, 'nz) + licn := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'licn) + objValUnwrap htpLabelSpadValue(htPage, 'licn) + lirn := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lirn) + objValUnwrap htpLabelSpadValue(htPage, 'lirn) + aerror := htpButtonValue(htPage,'afail) + afail := + aerror = 'azero => '0 + '1 + berror := htpButtonValue(htPage,'bfail) + bfail := + berror = 'bone => '1 + '0 + cerror := htpButtonValue(htPage,'cfail) + cfail := + cerror = 'cone => '1 + '0 + ifail := 100*cfail + 10*bfail + afail + droptl := htpLabelInputString(htPage, 'droptl) + densw := htpLabelInputString(htPage, 'densw) + ((n = '16 and nz = '40) and (licn = '90 and lirn = '50)) + => f01mafDefaultSolve(htPage,droptl,densw,ifail) + labelList := + "append"/[f(i) for i in 1..nz] where f(i) == + prefix := ('"\newline \tab{2} ") + anam := INTERN STRCONC ('"a",STRINGIMAGE i) + mid := ('"\tab{32} ") + rnam := INTERN STRCONC ('"irn",STRINGIMAGE i) + end := ('"\tab{42} ") + cnam := INTERN STRCONC ('"icn",STRINGIMAGE i) + [['text,:prefix],['bcStrings,[8, 0.0, anam, 'F]], + ['text,:mid],['bcStrings,[4, 0, rnam, 'PI]], + ['text,:end],['bcStrings,[4, 0, cnam, 'PI]]] + abortList := + [['bcStrings,[6, '"true", 'abortone, 'EM]], + ['bcStrings,[6, '"true", 'aborttwo, 'EM]], + ['bcStrings,[6, '"true", 'abortthree, 'EM]]] + prefix := ('"\blankline \menuitemstyle{}\tab{2} Abort: ") + abortList := [['text,:prefix],:abortList] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain EM ($EmptyMode)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :labelList,:abortList] + page := htInitPage("F01MAF - \htbitmap{llt} factorization of real sparse symmetric positive-definite matrix",nil) + htSay '"\menuitemstyle{}\tab{2} Non-zero elements of A: " + htSay '"\tab{30} \menuitemstyle{}\tab{32} Row: " + htSay '"\tab{40} \menuitemstyle{}\tab{42} Column: " + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'f01mafGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'nz,nz) + htpSetProperty(page,'licn,licn) + htpSetProperty(page,'lirn,lirn) + htpSetProperty(page,'droptl,droptl) + htpSetProperty(page,'densw,densw) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +f01mafDefaultSolve(htPage,droptl,densw,ifail) == + n := '16 + nz := '40 + licn := '90 + lirn := '50 + page := htInitPage("F01MAF - \htbitmap{llt} factorization of real sparse symmetric positive-definite matrix",nil) + htMakePage '( + (domainConditions + (isDomain PI (Positive Integer)) + (isDomain EM $EmptyMode) + (isDomain F (Float))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Non-zero elements of A: ") + (text . "\tab{30} \menuitemstyle{}\tab{32} Row: ") + (text . "\tab{40} \menuitemstyle{}\tab{42} Column: ") + (text . "\newline \tab{2}") + (bcStrings (8 "1.0" a1 F)) + (text . "\tab{32} ") + (bcStrings (4 1 irn1 PI)) + (text . "\tab{42} ") + (bcStrings (4 1 icn1 PI)) + (text . "\newline \tab{2}") + (bcStrings (8 "1.0" a2 F)) + (text . "\tab{32} ") + (bcStrings (4 2 irn2 PI)) + (text . "\tab{42} ") + (bcStrings (4 2 icn2 PI)) + (text . "\newline \tab{2}") + (bcStrings (8 "1.0" a3 F)) + (text . "\tab{32} ") + (bcStrings (4 3 irn3 PI)) + (text . "\tab{42} ") + (bcStrings (4 3 icn3 PI)) + (text . "\newline \tab{2}") + (bcStrings (8 "1.0" a4 F)) + (text . "\tab{32} ") + (bcStrings (4 4 irn4 PI)) + (text . "\tab{42} ") + (bcStrings (4 4 icn4 PI)) + (text . "\newline \tab{2}") + (bcStrings (8 "1.0" a5 F)) + (text . "\tab{32} ") + (bcStrings (4 5 irn5 PI)) + (text . "\tab{42} ") + (bcStrings (4 5 icn5 PI)) + (text . "\newline \tab{2}") + (bcStrings (8 "1.0" a6 F)) + (text . "\tab{32} ") + (bcStrings (4 6 irn6 PI)) + (text . "\tab{42} ") + (bcStrings (4 6 icn6 PI)) + (text . "\newline \tab{2}") + (bcStrings (8 "1.0" a7 F)) + (text . "\tab{32} ") + (bcStrings (4 7 irn7 PI)) + (text . "\tab{42} ") + (bcStrings (4 7 icn7 PI)) + (text . "\newline \tab{2}") + (bcStrings (8 "1.0" a8 F)) + (text . "\tab{32} ") + (bcStrings (4 8 irn8 PI)) + (text . "\tab{42} ") + (bcStrings (4 8 icn8 PI)) + (text . "\newline \tab{2}") + (bcStrings (8 "1.0" a9 F)) + (text . "\tab{32} ") + (bcStrings (4 9 irn9 PI)) + (text . "\tab{42} ") + (bcStrings (4 9 icn9 PI)) + (text . "\newline \tab{2}") + (bcStrings (8 "1.0" a10 F)) + (text . "\tab{32} ") + (bcStrings (4 10 irn10 PI)) + (text . "\tab{42} ") + (bcStrings (4 10 icn10 PI)) + (text . "\newline \tab{2}") + (bcStrings (8 "1.0" a11 F)) + (text . "\tab{32} ") + (bcStrings (4 11 irn11 PI)) + (text . "\tab{42} ") + (bcStrings (4 11 icn11 PI)) + (text . "\newline \tab{2}") + (bcStrings (8 "1.0" a12 F)) + (text . "\tab{32} ") + (bcStrings (4 12 irn12 PI)) + (text . "\tab{42} ") + (bcStrings (4 12 icn12 PI)) + (text . "\newline \tab{2}") + (bcStrings (8 "1.0" a13 F)) + (text . "\tab{32} ") + (bcStrings (4 13 irn13 PI)) + (text . "\tab{42} ") + (bcStrings (4 13 icn13 PI)) + (text . "\newline \tab{2}") + (bcStrings (8 "1.0" a14 F)) + (text . "\tab{32} ") + (bcStrings (4 14 irn14 PI)) + (text . "\tab{42} ") + (bcStrings (4 14 icn14 PI)) + (text . "\newline \tab{2}") + (bcStrings (8 "1.0" a15 F)) + (text . "\tab{32} ") + (bcStrings (4 15 irn15 PI)) + (text . "\tab{42} ") + (bcStrings (4 15 icn15 PI)) + (text . "\blankline ") + (text . "\newline \tab{2}") + (bcStrings (8 "1.0" a16 F)) + (text . "\tab{32} ") + (bcStrings (4 16 irn16 PI)) + (text . "\tab{42} ") + (bcStrings (4 16 icn16 PI)) + (text . "\newline \tab{2}") + (bcStrings (8 "-0.25" a17 F)) + (text . "\tab{32} ") + (bcStrings (4 1 irn17 PI)) + (text . "\tab{42} ") + (bcStrings (4 2 icn17 PI)) + (text . "\newline \tab{2}") + (bcStrings (8 "-0.25" a18 F)) + (text . "\tab{32} ") + (bcStrings (4 2 irn18 PI)) + (text . "\tab{42} ") + (bcStrings (4 3 icn18 PI)) + (text . "\newline \tab{2}") + (bcStrings (8 "-0.25" a19 F)) + (text . "\tab{32} ") + (bcStrings (4 3 irn19 PI)) + (text . "\tab{42} ") + (bcStrings (4 4 icn19 PI)) + (text . "\newline \tab{2}") + (bcStrings (8 "-0.25" a20 F)) + (text . "\tab{32} ") + (bcStrings (4 5 irn20 PI)) + (text . "\tab{42} ") + (bcStrings (4 6 icn20 PI)) + (text . "\newline \tab{2}") + (bcStrings (8 "-0.25" a21 F)) + (text . "\tab{32} ") + (bcStrings (4 6 irn21 PI)) + (text . "\tab{42} ") + (bcStrings (4 7 icn21 PI)) + (text . "\newline \tab{2}") + (bcStrings (8 "-0.25" a22 F)) + (text . "\tab{32} ") + (bcStrings (4 7 irn22 PI)) + (text . "\tab{42} ") + (bcStrings (4 8 icn22 PI)) + (text . "\newline \tab{2}") + (bcStrings (8 "-0.25" a23 F)) + (text . "\tab{32} ") + (bcStrings (4 9 irn23 PI)) + (text . "\tab{42} ") + (bcStrings (4 10 icn23 PI)) + (text . "\newline \tab{2}") + (bcStrings (8 "-0.25" a24 F)) + (text . "\tab{32} ") + (bcStrings (4 10 irn24 PI)) + (text . "\tab{42} ") + (bcStrings (4 11 icn24 PI)) + (text . "\newline \tab{2}") + (bcStrings (8 "-0.25" a25 F)) + (text . "\tab{32} ") + (bcStrings (4 11 irn25 PI)) + (text . "\tab{42} ") + (bcStrings (4 12 icn25 PI)) + (text . "\newline \tab{2}") + (bcStrings (8 "-0.25" a26 F)) + (text . "\tab{32} ") + (bcStrings (4 13 irn26 PI)) + (text . "\tab{42} ") + (bcStrings (4 14 icn26 PI)) + (text . "\newline \tab{2}") + (bcStrings (8 "-0.25" a27 F)) + (text . "\tab{32} ") + (bcStrings (4 14 irn27 PI)) + (text . "\tab{42} ") + (bcStrings (4 15 icn27 PI)) + (text . "\newline \tab{2}") + (bcStrings (8 "-0.25" a28 F)) + (text . "\tab{32} ") + (bcStrings (4 15 irn28 PI)) + (text . "\tab{42} ") + (bcStrings (4 16 icn28 PI)) + (text . "\newline \tab{2}") + (bcStrings (8 "-0.25" a29 F)) + (text . "\tab{32} ") + (bcStrings (4 1 irn29 PI)) + (text . "\tab{42} ") + (bcStrings (4 5 icn29 PI)) + (text . "\newline \tab{2}") + (bcStrings (8 "-0.25" a30 F)) + (text . "\tab{32} ") + (bcStrings (4 2 irn30 PI)) + (text . "\tab{42} ") + (bcStrings (4 6 icn30 PI)) + (text . "\newline \tab{2}") + (bcStrings (8 "-0.25" a31 F)) + (text . "\tab{32} ") + (bcStrings (4 3 irn31 PI)) + (text . "\tab{42} ") + (bcStrings (4 7 icn31 PI)) + (text . "\newline \tab{2}") + (bcStrings (8 "-0.25" a32 F)) + (text . "\tab{32} ") + (bcStrings (4 4 irn32 PI)) + (text . "\tab{42} ") + (bcStrings (4 8 icn32 PI)) + (text . "\newline \tab{2}") + (bcStrings (8 "-0.25" a33 F)) + (text . "\tab{32} ") + (bcStrings (4 5 irn33 PI)) + (text . "\tab{42} ") + (bcStrings (4 9 icn33 PI)) + (text . "\newline \tab{2}") + (bcStrings (8 "-0.25" a34 F)) + (text . "\tab{32} ") + (bcStrings (4 6 irn34 PI)) + (text . "\tab{42} ") + (bcStrings (4 10 icn34 PI)) + (text . "\newline \tab{2}") + (bcStrings (8 "-0.25" a35 F)) + (text . "\tab{32} ") + (bcStrings (4 7 irn35 PI)) + (text . "\tab{42} ") + (bcStrings (4 11 icn35 PI)) + (text . "\newline \tab{2}") + (bcStrings (8 "-0.25" a36 F)) + (text . "\tab{32} ") + (bcStrings (4 8 irn36 PI)) + (text . "\tab{42} ") + (bcStrings (4 12 icn36 PI)) + (text . "\newline \tab{2}") + (bcStrings (8 "-0.25" a37 F)) + (text . "\tab{32} ") + (bcStrings (4 9 irn37 PI)) + (text . "\tab{42} ") + (bcStrings (4 13 icn37 PI)) + (text . "\newline \tab{2}") + (bcStrings (8 "-0.25" a38 F)) + (text . "\tab{32} ") + (bcStrings (4 10 irn38 PI)) + (text . "\tab{42} ") + (bcStrings (4 14 icn38 PI)) + (text . "\newline \tab{2}") + (bcStrings (8 "-0.25" a39 F)) + (text . "\tab{32} ") + (bcStrings (4 11 irn39 PI)) + (text . "\tab{42} ") + (bcStrings (4 15 icn39 PI)) + (text . "\newline \tab{2}") + (bcStrings (8 "-0.25" a40 F)) + (text . "\tab{32} ") + (bcStrings (4 12 irn40 PI)) + (text . "\tab{42} ") + (bcStrings (4 16 icn40 PI)) + (text . "\blankline ") + (text . "\menuitemstyle{} \tab{2} Abort :") + (bcStrings (8 "true" abort_one EM)) + (bcStrings (8 "true" abort_two EM)) + (bcStrings (8 "true" abort_three EM))) + htMakeDoneButton('"Continue",'f01mafGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'nz,nz) + htpSetProperty(page,'licn,licn) + htpSetProperty(page,'lirn,lirn) + htpSetProperty(page,'droptl,droptl) + htpSetProperty(page,'densw,densw) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +f01mafGen htPage == + n := htpProperty(htPage,'n) + nz := htpProperty(htPage,'nz) + licn := htpProperty(htPage,'licn) + lirn := htpProperty(htPage,'lirn) + droptl := htpProperty(htPage,'droptl) + densw := htpProperty(htPage,'densw) + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + for i in 1..3 repeat + abort := STRCONC((first y).1," ") + y := rest y + abortList := [abort,:abortList] + astring := bcwords2liststring abortList + while y repeat + end := STRCONC ((first y).1," ") + y := rest y + mid := STRCONC ((first y).1," ") + y := rest y + top := STRCONC ((first y).1," ") + y := rest y + cList := [end,:cList] + rList := [mid,:rList] + matList := [top,:matList] + for i in 1..(licn-nz) repeat + cList := [:cList,'"0 "] + matList := [:matList,'"0 "] + for i in 1..(lirn-nz) repeat + rList := [:rList,'"0 "] + cstring := bcwords2liststring cList + rstring := bcwords2liststring rList + matstring := bcwords2liststring matList + prefix := STRCONC('"f01maf(",STRINGIMAGE n,", ",STRINGIMAGE nz,", ") + prefix := STRCONC(prefix,STRINGIMAGE licn,", ",STRINGIMAGE lirn,", ") + prefix := STRCONC(prefix,astring,",[",matstring) + prefix := STRCONC(prefix,"],[",rstring,"],[",cstring,"], ",droptl,", ",densw) + linkGen STRCONC(prefix,", ",STRINGIMAGE ifail,")") + + + + +f01mcf() == + htInitPage("F01MCF - \htbitmap{ldlt} factorization of real symmetric positive-definite variable-bandwidth matrix",nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\windowlink{Manual Page}{manpageXXf01mcf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f01mcf| '|NagMatrixOperationsPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "Computes the Cholesky factorization of a real symmetric positive") + (text . "-definite variable-bandwidth matrix {\it A} or order {\it n}. ") + (text . "That is, {\it A = }\htbitmap{ldlt}, where {\it L} is ") + (text . "a unit lower triangular matrix and {\it D} is a diagonal matrix.") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the order {\em n} of the matrix A ") + (text . "\htbitmap{great=} 1:") + (text . "\newline\tab{2} ") + (bcStrings (9 6 n PI)) + (text . "\blankline") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "\newline Enter the number of elements: ") + (text . "\newline\tab{2} ") + (bcStrings (9 14 lal 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", 'f01mcfSolve) + htShowPage() + +f01mcfSolve htPage == + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + lal := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lal) + objValUnwrap htpLabelSpadValue(htPage, 'lal) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + (n = '6 and lal = '14) => f01mcfDefaultSolve(htPage,ifail) + labelList := + "append"/[f(i) for i in 1..lal] where f(i) == + xnam := INTERN STRCONC ('"x",STRINGIMAGE i) + [['bcStrings,[6, 0.0, xnam, 'F]]] + nrowList := + "append"/[g(j) for j in 1..n] where g(j) == + nam := INTERN STRCONC ('"n",STRINGIMAGE j) + [['bcStrings,[6, 0, nam, 'PI]]] + prefix := ('"\blankline \menuitemstyle{}\tab{2} {\it NROW(n)} the width ") + prefix := STRCONC(prefix,"of the ith row of A: \newline \tab{2} ") + nrowList := [['text,:prefix],:nrowList] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :labelList,:nrowList] + page := htInitPage("F01MCF - \htbitmap{ldlt} factorization of real symmetric positive-definite variable-bandwidth matrix",nil) + htSay '"\menuitemstyle{}\tab{2} Elements of matrix {\it A} in row by row " + htSay '"order: \newline \tab{2} " + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'f01mcfGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'lal,lal) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +f01mcfDefaultSolve (htPage,ifail) == + n := '6 + lal := '14 + page := htInitPage("F01MCF - \htbitmap{ldlt} factorization of real symmetric positive-definite variable-bandwidth matrix",nil) + htMakePage '( + (domainConditions + (isDomain PI (Positive Integer)) + (isDomain F (Float))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Elements of matrix {\it A} in row by ") + (text . "row order: ") + (text . "\newline ") + (bcStrings (6 "1.0" x1 F)) + (bcStrings (6 "2.0" x2 F)) + (bcStrings (6 "5.0" x3 F)) + (bcStrings (6 "3.0" x4 F)) + (bcStrings (6 "13.0" x5 F)) + (bcStrings (6 "16.0" x6 F)) + (bcStrings (6 "5.0" x7 F)) + (bcStrings (6 "14.0" x8 F)) + (bcStrings (6 "18.0" x9 F)) + (bcStrings (6 "8.0" x10 F)) + (bcStrings (6 "55.0" x11 F)) + (bcStrings (6 "24.0" x12 F)) + (bcStrings (6 "17.0" x13 F)) + (bcStrings (6 "77.0" x14 F)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2} {\it NROW(n)} the width of the ith row ") + (text . "of A: ") + (text . "\newline ") + (bcStrings (6 1 n1 PI)) + (bcStrings (6 2 n2 PI)) + (bcStrings (6 2 n3 PI)) + (bcStrings (6 1 n4 PI)) + (bcStrings (6 5 n5 PI)) + (bcStrings (6 3 n6 PI)) + (text . "\blankline ")) + htMakeDoneButton('"Continue",'f01mcfGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'lal,lal) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +f01mcfGen htPage == + n := htpProperty(htPage,'n) + lal := htpProperty(htPage,'lal) + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + for i in 1..n repeat + right := STRCONC ((first y).1," ") + y := rest y + nrowList := [right,:nrowList] + nrowstring := bcwords2liststring nrowList + while y repeat + right := STRCONC ((first y).1," ") + y := rest y + matList := [right,:matList] + matstring := bcwords2liststring matList + prefix := STRCONC('"f01mcf(",STRINGIMAGE n,", [",matstring,"], ") + prefix := STRCONC(prefix,STRINGIMAGE lal,", [",nrowstring,"], ") + linkGen STRCONC(prefix,STRINGIMAGE ifail,")") + + +f01qcf() == + htInitPage('"F01QCF - QR factorization or real m by n matrix (m \htbitmap{great=} n)",nil) + htMakePage '( + (domainConditions + (isDomain F (Float)) + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXf01qcf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f01qcf| '|NagMatrixOperationsPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\newline ") + (text . "Finds the QR factorization of a real {\it m} by {it n} ({\it m ") + (text . "\htbitmap{great=} n}) matrix {\it A}, which ") + (text . "is factorized as \htbitmap{f01qcf}, ") + (text . "where {\it m > n} and {\it A = QR } when {\it m = n }, where ") + (text . "{\it Q} is an {\it m} by {\it m } orthogonal matrix and {\it R} ") + (text . "is an {\it n} by {\it n} upper triangular matrix. The {\it k}th ") + (text . "transformation matrix,{\it Qk}, ") + (text . "which is used to introduce zeros into the {\it k}th column of ") + (text . "{\it A}, is given in the form ") + (text . "\htbitmap{f01qcf1}, ") + (text . "where \htbitmap{f01qcf2}, ") + (text . "\htbitmap{f01qcf3}, ") + (text . "\htbitmap{zetak} is a scalar and ") + (text . "\htbitmap{zk} is an (m-k) element vector. ") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline Rows of matrix A, {\it m}: ") + (text . "\tab{32} \menuitemstyle{} \tab{34} ") + (text . "Columns of matrix A, {\it n}: \newline \tab{2} ") + (bcStrings (6 5 m PI)) + (text . "\tab{34} ") + (bcStrings (6 3 n PI)) +-- (text . "\blankline ") +-- (text . "\newline ") +-- (text . "\menuitemstyle{} \tab{2} ") +-- (text . "\newline First dimension of A, {\it lda} ") +-- (text . "\htbitmap{great=} m: ") +-- (text . "\newline \tab{2} ") +-- (bcStrings (6 5 lda PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Ifail value: ") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'f01qcfSolve) + htShowPage() + +f01qcfSolve htPage == + m := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) + objValUnwrap htpLabelSpadValue(htPage, 'm) + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + lda := m +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lda) +-- objValUnwrap htpLabelSpadValue(htPage, 'lda) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + (m = '5 and n = '3) => f01qcfDefaultSolve(htPage,lda,ifail) + matList := + "append"/[f(i,n) for i in 1..lda] where f(i,n) == + labelList := + "append"/[g(i,j) for j in 1..n] where g(i,j) == + anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) + [['bcStrings,[6, "0.0", anam, 'F]]] + prefix := ('"\newline \tab{2} ") + labelList := [['text,:prefix],:labelList] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :matList] + page := htInitPage("F01QCF - QR factorization or real m by n matrix (m \htbitmap{great=} n)",nil) + htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " + htSay '"\newline \tab{2} " + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'f01qcfGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'m,m) +-- htpSetProperty(page,'lda,lda) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +f01qcfDefaultSolve (htPage,lda,ifail) == + n := '3 + m := '5 + page := htInitPage('"F01QCF - QR factorization or real m by n matrix (m \htbitmap{great=} n)",nil) + htMakePage '( + (domainConditions + (isDomain F (Float)) + (isDomain I (Integer))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ") + (text . "\newline \tab{2} ") + (bcStrings (6 "2.0" a11 F)) + (bcStrings (6 "2.5" a12 F)) + (bcStrings (6 "2.5" a13 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "2.0" a21 F)) + (bcStrings (6 "2.5" a22 F)) + (bcStrings (6 "2.5" a23 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "1.6" a31 F)) + (bcStrings (6 "-0.4" a32 F)) + (bcStrings (6 "2.8" a33 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "2.0" a41 F)) + (bcStrings (6 "-0.5" a42 F)) + (bcStrings (6 "0.5" a43 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "1.2" a51 F)) + (bcStrings (6 "-0.3" a52 F)) + (bcStrings (6 "-2.9" a53 F))) + htMakeDoneButton('"Continue",'f01qcfGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'m,m) +-- htpSetProperty(page,'lda,lda) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +f01qcfGen htPage == + n := htpProperty(htPage,'n) + m := htpProperty(htPage,'m) +-- lda := htpProperty(htPage,'lda) + lda := m + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + y := REVERSE y + for i in 1..lda repeat + for j in 1..n repeat + elm := STRCONC((first y).1," ") + rowList := [:rowList,elm] + y := rest y + matform := [:matform,rowList] + rowList := [] + matstring := bcwords2liststring [bcwords2liststring x for x in matform] + prefix := STRCONC('"f01qcf(",STRINGIMAGE m,", ",STRINGIMAGE n,", ") + prefix := STRCONC(prefix,STRINGIMAGE lda,", ",matstring,", ") + prefix := STRCONC(prefix,STRINGIMAGE ifail,")") + linkGen prefix + +f01qdf() == + htInitPage('"F01QDF - Operations with orthogonal matrices, compute {\it QB} or \htbitmap{f01qdf} after factorization by F01QCF or F01QDF",nil) + htMakePage '( + (domainConditions + (isDomain F (Float)) + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXf01qdf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f01qdf| '|NagMatrixOperationsPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\newline ") + (text . "Performs one of the transformations {\it B = QB or B = }") + (text . "\htbitmap{f01qdf}, where {\it B} is a real {\it m} ") + (text . "by {\it ncolb} matrix and {\it Q} is an {\it m} by {\it m} ") + (text . "orthogonal matrix assumed to be given by {\it Q = }") + (text . "\htbitmap{f01qdf1}, \htbitmap{f01qdf2} ") + (text . "being given in the form ") + (text . "\htbitmap{f01qcf1}, ") + (text . "where \htbitmap{f01qcf2}, ") + (text . "\htbitmap{f01qcf3}, ") + (text . "\htbitmap{zetak} is a scalar and ") + (text . "\htbitmap{zk} is an (m-k) element vector. ") + (text . "The routine is intended for use following F01QCF or F01QFF. ") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline Rows of matrix A, {\it m}: ") + (text . "\tab{32} \menuitemstyle{} \tab{34} ") + (text . "Columns of matrix A, {\it n}: \newline \tab{2} ") + (bcStrings (6 5 m PI)) + (text . "\tab{34} ") + (bcStrings (6 3 n PI)) +-- (text . "\blankline ") +-- (text . "\newline ") +-- (text . "\menuitemstyle{} \tab{2} ") +-- (text . "\newline First dimension of A, {\it lda} ") +-- (text . "\htbitmap{great=} m: ") +-- (text . "\tab{32} \menuitemstyle{} \tab{34} ") +-- (text . "First dimension of B, {\it ldb} ") +-- (text . "\htbitmap{great=} m: ") +-- (text . "\newline \tab{2} ") +-- (bcStrings (6 5 lda PI)) +-- (text . "\tab{34} ") +-- (bcStrings (6 5 ldb PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Number of columns of matrix B {\it ncolb}: ") + (text . "\newline \tab{2} ") + (bcStrings (6 2 ncolb PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Transformation to be performed: ") + (radioButtons trans + (" " " {\it B = QB}" no_trans) + (" " " {\it B =} \htbitmap{f01qdf}" trans)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Where the elements can be found: ") + (radioButtons wheret + (" " " the elements of \zeta are in A" in_a) + (" " " the elements of \zeta are in ZETA, returned by F01QCF/F01QFF" seperate)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Ifail value: ") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'f01qdfSolve) + htShowPage() + +f01qdfSolve htPage == + m := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) + objValUnwrap htpLabelSpadValue(htPage, 'm) + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + lda := m +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lda) +-- objValUnwrap htpLabelSpadValue(htPage, 'lda) + ldb := m +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ldb) +-- objValUnwrap htpLabelSpadValue(htPage, 'ldb) + ncolb := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ncolb) + objValUnwrap htpLabelSpadValue(htPage, 'ncolb) + operation := htpButtonValue(htPage,'trans) + trans := + operation = 'no_trans => '"n" + '"t" + elements := htpButtonValue(htPage,'wheret) + wheret := + elements = 'in_a => '"i" + '"s" + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + ((m = '5 and n = '3) and ncolb = '2) => f01qdfDefaultSolve(htPage,lda,ldb,trans,wheret,ifail) + matList := + "append"/[fa(i,n) for i in 1..lda] where fa(i,n) == + labelList := + "append"/[ga(i,j) for j in 1..n] where ga(i,j) == + anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) + [['bcStrings,[6, "0.0", anam, 'F]]] + prefix := ('"\newline \tab{2} ") + labelList := [['text,:prefix],:labelList] + bList := + "append"/[fb(i,ncolb) for i in 1..ldb] where fb(i,ncolb) == + labelList := + "append"/[gb(i,j) for j in 1..ncolb] where gb(i,j) == + bnam := INTERN STRCONC ('"b",STRINGIMAGE i, STRINGIMAGE j) + [['bcStrings,[6, "0.0", bnam, 'F]]] + prefix := ('"\newline \tab{2} ") + labelList := [['text,:prefix],:labelList] + prefix := ("\blankline \menuitemstyle{}\tab{2} Enter values of {\it B}: ") + bList := [['text,:prefix],:bList] + zList := + "append"/[fz(i) for i in 1..n] where fz(i) == + znam := INTERN STRCONC ('"z",STRINGIMAGE i) + [['bcStrings,[6, "0.0", znam, 'F]]] + prefix := ("\blankline \menuitemstyle{}\tab{2} Enter values of \zeta ") + prefix := STRCONC(prefix,"(if required): \newline \tab{2}") + zList := [['text,:prefix],:zList] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :matList,:bList,:zList] + page := htInitPage('"F01QDF - Operations with orthogonal matrices, compute {\it QB} or \htbitmap{f01qdf} after factorization by F01QCF or F01QDF",nil) + htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " + htSay '"\newline \tab{2} " + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'f01qdfGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'m,m) +-- htpSetProperty(page,'lda,lda) +-- htpSetProperty(page,'ldb,ldb) + htpSetProperty(page,'ncolb,ncolb) + htpSetProperty(page,'trans,trans) + htpSetProperty(page,'wheret,wheret) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +f01qdfDefaultSolve (htPage,lda,ldb,trans,wheret,ifail) == + n := '3 + m := '5 + ncolb := '2 + page := htInitPage('"F01QDF - Operations with orthogonal matrices, compute {\it QB} or \htbitmap{f01qdf} after factorization by F01QCF or F01QDF",nil) + htMakePage '( + (domainConditions + (isDomain F (Float)) + (isDomain I (Integer))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ") + (text . "\newline \tab{2} ") + (bcStrings (6 "2.0" a11 F)) + (bcStrings (6 "2.5" a12 F)) + (bcStrings (6 "2.5" a13 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "2.0" a21 F)) + (bcStrings (6 "2.5" a22 F)) + (bcStrings (6 "2.5" a23 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "1.6" a31 F)) + (bcStrings (6 "-0.4" a32 F)) + (bcStrings (6 "2.8" a33 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "2.0" a41 F)) + (bcStrings (6 "-0.5" a42 F)) + (bcStrings (6 "0.5" a43 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "1.2" a51 F)) + (bcStrings (6 "-0.3" a52 F)) + (bcStrings (6 "-2.9" a53 F)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2} Enter values of {\it B}: ") + (text . "\newline \tab{2} ") + (bcStrings (6 "1.1" b11 F)) + (bcStrings (6 "0.0" b12 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.9" b21 F)) + (bcStrings (6 "0.0" b22 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.6" b31 F)) + (bcStrings (6 "1.32" b32 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" b41 F)) + (bcStrings (6 "1.1" b42 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "-0.8" b51 F)) + (bcStrings (6 "-0.26" b52 F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Enter values of \zeta (if required): ") + (text . "\newline \tab{2} ") + (bcStrings (10 "0.0" z1 F)) + (bcStrings (10 "0.0" z2 F)) + (bcStrings (10 "0.0" z3 F)) + (text . "\blankline ")) + htMakeDoneButton('"Continue",'f01qdfGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'m,m) +-- htpSetProperty(page,'lda,lda) +-- htpSetProperty(page,'ldb,ldb) + htpSetProperty(page,'ncolb,ncolb) + htpSetProperty(page,'trans,trans) + htpSetProperty(page,'wheret,wheret) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +f01qdfGen htPage == + n := htpProperty(htPage,'n) + m := htpProperty(htPage,'m) +-- lda := htpProperty(htPage,'lda) +-- ldb := htpProperty(htPage,'ldb) + lda := m + ldb := m + ncolb := htpProperty(htPage,'ncolb) + trans := htpProperty(htPage,'trans) + wheret := htpProperty(htPage,'wheret) + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + for i in 1..n repeat + left := STRCONC((first y).1," ") + y := rest y + zetalist := [left,:zetalist] + zetastring := bcwords2liststring zetalist + y := REVERSE y + for i in 1..lda repeat + for j in 1..n repeat + elm := STRCONC((first y).1," ") + rowList := [:rowList,elm] + y := rest y + matform := [:matform,rowList] + rowList := [] + matstring := bcwords2liststring [bcwords2liststring x for x in matform] + for i in 1..ldb repeat + for j in 1..ncolb repeat + elm := STRCONC((first y).1," ") + rowList := [:rowList,elm] + y := rest y + bform := [:bform,rowList] + rowList := [] + bstring := bcwords2liststring [bcwords2liststring x for x in bform] + prefix := STRCONC('"f01qdf(_"",trans,"_",_"",wheret,"_",",STRINGIMAGE m,", ") + prefix := STRCONC(prefix,STRINGIMAGE n,", ",matstring,", ",STRINGIMAGE lda) + prefix := STRCONC(prefix,",[",zetastring,"],",STRINGIMAGE ncolb,", ") + prefix := STRCONC(prefix,STRINGIMAGE ldb,", ",bstring,", ",STRINGIMAGE ifail,")") + linkGen prefix + + +f01qef() == + htInitPage('"F01QEF - Operations with orthogonal matrices, form columns of {\it Q} after factorization by F01QCF or F01QFF",nil) + htMakePage '( + (domainConditions + (isDomain F (Float)) + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXf01qef} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f01qef| '|NagMatrixOperationsPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\newline ") + (text . "Returns the first {\it ncolq} columns of the real {\it m} by ") + (text . "{\it n} orthogonal matrix {\it Q}, where {\it Q} is assumed ") + (text . "to be given by {\it Q = }\htbitmap{f01qdf1}, ") + (text . "\htbitmap{f01qdf2} being given in the form ") + (text . "\htbitmap{f01qcf1}, ") + (text . "where \htbitmap{f01qcf2}, ") + (text . "\htbitmap{f01qcf3}, ") + (text . "\htbitmap{zetak} is a scalar and ") + (text . "\htbitmap{zk} is an (m-k) element vector. ") + (text . "The routine is intended for use following F01QCF or F01QFF. ") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline Rows of matrix A, {\it m}: ") + (text . "\tab{32} \menuitemstyle{} \tab{34} ") + (text . "Columns of matrix A, {\it n}: \newline \tab{2} ") + (bcStrings (6 5 m PI)) + (text . "\tab{34} ") + (bcStrings (6 3 n PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") +-- (text . "\newline First dimension of A, {\it lda} ") +-- (text . "\htbitmap{great=} m: ") +-- (text . "\tab{32} \menuitemstyle{} \tab{34} ") + (text . "Number columns of matrix Q {\it ncolq}: ") + (text . "\newline \tab{2} ") +-- (bcStrings (6 5 lda PI)) +-- (text . "\tab{34} ") + (bcStrings (6 5 ncolq PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Where the elements can be found: ") + (radioButtons wheret + (" " " the elements of \zeta are in ZETA, returned by F01QCF/F01QFF" subsequent) + (" " " the elements of \zeta are in A" initial)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Ifail value: ") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'f01qefSolve) + htShowPage() + +f01qefSolve htPage == + m := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) + objValUnwrap htpLabelSpadValue(htPage, 'm) + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + lda := m +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lda) +-- objValUnwrap htpLabelSpadValue(htPage, 'lda) + ncolq := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ncolq) + objValUnwrap htpLabelSpadValue(htPage, 'ncolq) + elements := htpButtonValue(htPage,'wheret) + wheret := + elements = 'initial => '"i" + '"s" + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + ((m = '5 and n = '3) and ncolq = '5) => f01qefDefaultSolve(htPage,lda,wheret,ifail) + matList := + "append"/[fa(i,ncolq) for i in 1..lda] where fa(i,ncolq) == + labelList := + "append"/[ga(i,j) for j in 1..ncolq] where ga(i,j) == + anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) + [['bcStrings,[7, "0.0", anam, 'F]]] + prefix := ('"\newline ") + labelList := [['text,:prefix],:labelList] + zList := + "append"/[fz(i) for i in 1..n] where fz(i) == + znam := INTERN STRCONC ('"z",STRINGIMAGE i) + [['bcStrings,[7, "0.0", znam, 'F]]] + prefix := ("\blankline \menuitemstyle{}\tab{2} Enter values of \zeta ") + prefix := STRCONC(prefix,"(if required): \newline ") + zList := [['text,:prefix],:zList] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :matList,:zList] + page := htInitPage('"F01QEF - Operations with orthogonal matrices, form columns of {\it Q} after factorization by F01QCF or F01QFF",nil) + htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it Q}: " + htSay '"\newline " + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'f01qefGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'m,m) +-- htpSetProperty(page,'lda,lda) + htpSetProperty(page,'ncolq,ncolq) + htpSetProperty(page,'wheret,wheret) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +f01qefDefaultSolve (htPage,lda,wheret,ifail) == + n := '3 + m := '5 + ncolq := '5 + page := htInitPage('"F01QEF - Operations with orthogonal matrices, form columns of {\it Q} after factorization by F01QCF or F01QFF",nil) + htMakePage '( + (domainConditions + (isDomain F (Float)) + (isDomain I (Integer))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Enter values of {\it Q}") + (text . "(in this case returned by the default entries of F01QCF) : ") + (text . "\newline ") + (bcStrings (7 "-4.0" a11 F)) + (bcStrings (7 "-2.0" a12 F)) + (bcStrings (7 "-3.0" a13 F)) + (bcStrings (7 "0.0" a14 F)) + (bcStrings (7 "0.0" a15 F)) + (text . "\newline ") + (bcStrings (7 "0.4085" a21 F)) + (bcStrings (7 "-3.0" a22 F)) + (bcStrings (7 "-2.0" a23 F)) + (bcStrings (7 "0.0" a24 F)) + (bcStrings (7 "0.0" a25 F)) + (text . "\newline ") + (bcStrings (7 "0.3266" a31 F)) + (bcStrings (7 "-0.4619" a32 F)) + (bcStrings (7 "-4.0" a33 F)) + (bcStrings (7 "0.0" a34 F)) + (bcStrings (7 "0.0" a35 F)) + (text . "\newline ") + (bcStrings (7 "0.4082" a41 F)) + (bcStrings (7 "-0.5774" a42 F)) + (bcStrings (7 "0.0" a43 F)) + (bcStrings (7 "0.0" a44 F)) + (bcStrings (7 "0.0" a45 F)) + (text . "\newline ") + (bcStrings (7 "0.2449" a51 F)) + (bcStrings (7 "-0.3464" a52 F)) + (bcStrings (7 "-0.6326" a53 F)) + (bcStrings (7 "0.0" a54 F)) + (bcStrings (7 "0.0" a55 F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Enter values of \zeta: ") + (text . "\newline ") + (bcStrings (10 "1.2247" z1 F)) + (bcStrings (10 "1.1547" z2 F)) + (bcStrings (10 "1.2649" z3 F)) + (text . "\blankline ")) + htMakeDoneButton('"Continue",'f01qefGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'m,m) +-- htpSetProperty(page,'lda,lda) + htpSetProperty(page,'ncolq,ncolq) + htpSetProperty(page,'wheret,wheret) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +f01qefGen htPage == + n := htpProperty(htPage,'n) + m := htpProperty(htPage,'m) +-- lda := htpProperty(htPage,'lda) + lda := m + ncolq := htpProperty(htPage,'ncolq) + wheret := htpProperty(htPage,'wheret) + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + for i in 1..n repeat + left := STRCONC((first y).1," ") + y := rest y + zetalist := [left,:zetalist] + zetastring := bcwords2liststring zetalist + y := REVERSE y + for i in 1..lda repeat + for j in 1..ncolq repeat + elm := STRCONC((first y).1," ") + rowList := [:rowList,elm] + y := rest y + matform := [:matform,rowList] + rowList := [] + matstring := bcwords2liststring [bcwords2liststring x for x in matform] + prefix := STRCONC('"f01qef(_"",wheret,"_",",STRINGIMAGE m,", ") + prefix := STRCONC(prefix,STRINGIMAGE n,", ",STRINGIMAGE lda,", ") + prefix := STRCONC(prefix,STRINGIMAGE ncolq,",[",zetastring,"],") + prefix := STRCONC(prefix,matstring,", ",STRINGIMAGE ifail,")") + linkGen prefix + +f01rcf() == + htInitPage('"F01RCF - {\it QR} factorization of complex {\it m} by {\it n} matrix (m \htbitmap{great=} n)",nil) + htMakePage '( + (domainConditions + (isDomain F (Float)) + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXf01rcf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f01rcf| '|NagMatrixOperationsPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\newline ") + (text . "Finds the QR factorization of the complex m by n matrix {\it A},") + (text . " which is factorized as \htbitmap{f01qcf}, where m > n") + (text . " and A = QR when m = n , where Q is an m by m unitary matrix ") + (text . "and R is an n by n upper triangular matrix with real diagonal ") + (text . "elements. The {\it k}th transformation matrix,{\it Qk}, ") + (text . "which is used to introduce zeros into the {\it k}th column of ") + (text . "{\it A}, is given in the form ") + (text . "\htbitmap{f01qcf1}, ") + (text . "where \htbitmap{f01rdf2}, ") + (text . "\htbitmap{f01qcf3}, ") + (text . "\htbitmap{gammak} is a scalar for which Re ") + (text . "\htbitmap{gammak} = 1.0, \htbitmap{zetak} ") + (text . "is a real scalar and \htbitmap{zk} is an ") + (text . "(m-k) element vector. ") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline Rows of matrix A, {\it m}: ") + (text . "\tab{32} \menuitemstyle{} \tab{34} ") + (text . "Columns of matrix A, {\it n}: \newline \tab{2} ") + (bcStrings (6 5 m PI)) + (text . "\tab{34} ") + (bcStrings (6 3 n PI)) +-- (text . "\blankline ") +-- (text . "\newline ") +-- (text . "\menuitemstyle{} \tab{2} ") +-- (text . "\newline First dimension of A, {\it lda} ") +-- (text . "\htbitmap{great=} m: ") +-- (text . "\newline \tab{2} ") +-- (bcStrings (6 5 lda PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Ifail value: ") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'f01rcfSolve) + htShowPage() + +f01rcfSolve htPage == + m := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) + objValUnwrap htpLabelSpadValue(htPage, 'm) + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + lda := m +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lda) +-- objValUnwrap htpLabelSpadValue(htPage, 'lda) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + (m = '5 and n = '3) => f01rcfDefaultSolve(htPage,ifail) + matList := + "append"/[fa(i,n) for i in 1..lda] where fa(i,n) == + labelList := + "append"/[ga(i,j) for j in 1..n] where ga(i,j) == + anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) + [['bcStrings,[16, "0.0 + 0.0*%i", anam, 'F]]] + prefix := ('"\newline \tab{2} ") + labelList := [['text,:prefix],:labelList] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :matList] + page := htInitPage('"F01RCF - {\it QR} factorization of complex {\it m} by {\it n} matrix (m \htbitmap{great=} n)",nil) + htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " + htSay '"\newline \tab{2} " + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'f01rcfGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'m,m) +-- htpSetProperty(page,'lda,lda) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +f01rcfDefaultSolve (htPage,ifail) == + n := '3 + m := '5 + lda := '5 + page := htInitPage('"F01RCF - {\it QR} factorization of complex {\it m} by {\it n} matrix (m \htbitmap{great=} n)",nil) + htMakePage '( + (domainConditions + (isDomain F (Float)) + (isDomain I (Integer))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ") + (text . "\newline \tab{2} ") + (bcStrings (15 "0.5*%i" a11 F)) + (bcStrings (15 "-0.5 + 1.5*%i" a12 F)) + (bcStrings (15 "-1.0 + 1.0*%i" a13 F)) + (text . "\newline \tab{2} ") + (bcStrings (15 "0.4 + 0.3*%i" a21 F)) + (bcStrings (15 "0.9 + 1.3*%i" a22 F)) + (bcStrings (15 "0.2 + 1.4*%i" a23 F)) + (text . "\newline \tab{2} ") + (bcStrings (15 "0.4" a31 F)) + (bcStrings (15 "-0.4 + 0.4*%i" a32 F)) + (bcStrings (15 "1.8" a33 F)) + (text . "\newline \tab{2} ") + (bcStrings (15 "0.3 - 0.4*%i" a41 F)) + (bcStrings (15 "0.1 + 0.7*%i" a42 F)) + (bcStrings (15 "0.0" a43 F)) + (text . "\newline \tab{2} ") + (bcStrings (15 "-0.3*%i" a51 F)) + (bcStrings (15 "0.3 + 0.3*%i" a52 F)) + (bcStrings (15 "2.4*%i" a53 F)) + (text . "\blankline ")) + htMakeDoneButton('"Continue",'f01rcfGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'m,m) +-- htpSetProperty(page,'lda,lda) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +f01rcfGen htPage == + n := htpProperty(htPage,'n) + m := htpProperty(htPage,'m) +-- lda := htpProperty(htPage,'lda) + lda := m + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + y := REVERSE y + for i in 1..lda repeat + for j in 1..n repeat + elm := STRCONC((first y).1," ") + rowList := [:rowList,elm] + y := rest y + matform := [:matform,rowList] + rowList := [] + matstring := bcwords2liststring [bcwords2liststring x for x in matform] + prefix := STRCONC('"f01rcf(",STRINGIMAGE m,", ",STRINGIMAGE n,", ") + prefix := STRCONC(prefix,STRINGIMAGE lda,", ",matstring) + linkGen STRCONC(prefix,", ",STRINGIMAGE ifail,")") + +f01rdf() == + htInitPage('"F01RDF - Operations with unitary matrices, compute {\it QB} or \htbitmap{f01rdf} after factorization by F01QCF",nil) + htMakePage '( + (domainConditions + (isDomain F (Float)) + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXf01rdf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f01rdf| '|NagMatrixOperationsPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\newline ") + (text . "Performs one of the transformations B = QB or B = ") + (text . "\htbitmap{f01rdf}, where B is an m ") + (text . "by ncolb matrix and Q is an m by m ") + (text . "unitary matrix assumed to be given by Q = ") + (text . "\htbitmap{f01rdf1}, \htbitmap{f01qdf2} ") + (text . "being given in the form \htbitmap{f01qcf1}, ") + (text . "where \htbitmap{f01rdf2}, \htbitmap{f01qcf3}") + (text . ", \htbitmap{gammak} is a scalar for which Re ") + (text . "\htbitmap{gammak} = 1.0, \htbitmap{zetak} ") + (text . "is a real scalar and \htbitmap{zk} is an ") + (text . "(m-k) element vector. ") + (text . "The routine is intended for use following F01QCF or F01QFF. ") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline Rows of matrix A, {\it m}: ") + (text . "\tab{32} \menuitemstyle{} \tab{34} ") + (text . "Columns of matrix A, {\it n}: \newline \tab{2} ") + (bcStrings (6 5 m PI)) + (text . "\tab{34} ") + (bcStrings (6 3 n PI)) +-- (text . "\blankline ") +-- (text . "\newline ") +-- (text . "\menuitemstyle{} \tab{2} ") +-- (text . "\newline First dimension of A, {\it lda} ") +-- (text . "\htbitmap{great=} m: ") +-- (text . "\tab{32} \menuitemstyle{} \tab{34} ") +-- (text . "First dimension of B, {\it ldb} ") +-- (text . "\htbitmap{great=} m: ") +-- (text . "\newline \tab{2} ") +-- (bcStrings (6 5 lda PI)) +-- (text . "\tab{34} ") +-- (bcStrings (6 5 ldb PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Number of columns of matrix B {\it ncolb}: ") + (text . "\newline \tab{2} ") + (bcStrings (6 2 ncolb PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Transformation to be performed: ") + (radioButtons trans + (" " " {\it B = QB}" no_trans) + (" " " {\it B =} \htbitmap{f01rdf} (Conjugate Transpose)" trans)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Where the elements can be found: ") + (radioButtons wheret + (" " " the elements of \theta are in A" in_a) + (" " " the elements of \theta are in THETA" seperate)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Ifail value: ") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'f01rdfSolve) + htShowPage() + +f01rdfSolve htPage == + m := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) + objValUnwrap htpLabelSpadValue(htPage, 'm) + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + lda := m +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lda) +-- objValUnwrap htpLabelSpadValue(htPage, 'lda) + ldb := m +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ldb) +-- objValUnwrap htpLabelSpadValue(htPage, 'ldb) + ncolb := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ncolb) + objValUnwrap htpLabelSpadValue(htPage, 'ncolb) + operation := htpButtonValue(htPage,'trans) + trans := + operation = 'no_trans => '"n" + '"c" + elements := htpButtonValue(htPage,'wheret) + wheret := + elements = 'in_a => '"i" + '"c" + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + ((m = '5 and n = '3) and ncolb = '2) => f01rdfDefaultSolve(htPage,lda,ldb,trans,wheret,ifail) + matList := + "append"/[fa(i,n) for i in 1..lda] where fa(i,n) == + labelList := + "append"/[ga(i,j) for j in 1..n] where ga(i,j) == + anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) + [['bcStrings,[16, "0.0 + 0.0*%i", anam, 'F]]] + prefix := ('"\newline \tab{2} ") + labelList := [['text,:prefix],:labelList] + bList := + "append"/[fb(i,ncolb) for i in 1..ldb] where fb(i,ncolb) == + labelList := + "append"/[gb(i,j) for j in 1..ncolb] where gb(i,j) == + bnam := INTERN STRCONC ('"b",STRINGIMAGE i, STRINGIMAGE j) + [['bcStrings,[16, "0.0 + 0.0*%i", bnam, 'F]]] + prefix := ('"\newline \tab{2} ") + labelList := [['text,:prefix],:labelList] + prefix := ("\blankline \menuitemstyle{}\tab{2} Enter values of {\it B}: ") + bList := [['text,:prefix],:bList] + zList := + "append"/[fz(i) for i in 1..n] where fz(i) == + znam := INTERN STRCONC ('"z",STRINGIMAGE i) + [['bcStrings,[16, "0.0", znam, 'F]]] + prefix := ("\blankline \menuitemstyle{}\tab{2} Enter values of \theta ") + prefix := STRCONC(prefix,"(if required): \newline \tab{2}") + zList := [['text,:prefix],:zList] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :matList,:bList,:zList] + page := htInitPage('"F01RDF - Operations with orthogonal matrices, compute {\it QB} or \htbitmap{f01rdf} after factorization by F01QCF or F01RDF",nil) + htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " + htSay '"\newline \tab{2} " + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'f01rdfGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'m,m) +-- htpSetProperty(page,'lda,lda) +-- htpSetProperty(page,'ldb,ldb) + htpSetProperty(page,'ncolb,ncolb) + htpSetProperty(page,'trans,trans) + htpSetProperty(page,'wheret,wheret) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +f01rdfDefaultSolve (htPage,lda,ldb,trans,wheret,ifail) == + n := '3 + m := '5 + ncolb := '2 + page := htInitPage('"F01RDF - Operations with orthogonal matrices, compute {\it QB} or \htbitmap{f01rdf} after factorization by F01QCF or F01RDF",nil) + htMakePage '( + (domainConditions + (isDomain F (Float)) + (isDomain I (Integer))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ") + (text . "\newline \tab{2} ") + (bcStrings (15 "0.5*%i" a11 F)) + (bcStrings (15 "-0.5 + 1.5*%i" a12 F)) + (bcStrings (15 "-1.0 + 1.0*%i" a13 F)) + (text . "\newline \tab{2} ") + (bcStrings (15 "0.4 + 0.3*%i" a21 F)) + (bcStrings (15 "0.9 + 1.3*%i" a22 F)) + (bcStrings (15 "0.2 + 1.4*%i" a23 F)) + (text . "\newline \tab{2} ") + (bcStrings (15 "0.4" a31 F)) + (bcStrings (15 "-0.4 + 0.4*%i" a32 F)) + (bcStrings (15 "1.8" a33 F)) + (text . "\newline \tab{2} ") + (bcStrings (15 "0.3 - 0.4*%i" a41 F)) + (bcStrings (15 "0.1 + 0.7*%i" a42 F)) + (bcStrings (15 "0.0" a43 F)) + (text . "\newline \tab{2} ") + (bcStrings (15 "-0.3*%i" a51 F)) + (bcStrings (15 "0.3 + 0.3*%i" a52 F)) + (bcStrings (15 "2.4" a53 F)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2} Enter values of {\it B}: ") + (text . "\newline \tab{2} ") + (bcStrings (15 "-0.55 + 1.05*%i" b11 F)) + (bcStrings (15 "0.45 + 1.05*%i" b12 F)) + (text . "\newline \tab{2} ") + (bcStrings (15 "0.49 + 0.93*%i" b21 F)) + (bcStrings (15 "1.09 + 0.13*%i" b22 F)) + (text . "\newline \tab{2} ") + (bcStrings (15 "0.56 - 0.16*%i" b31 F)) + (bcStrings (15 "0.64 + 0.16*%i" b32 F)) + (text . "\newline \tab{2} ") + (bcStrings (15 "0.39 + 0.23*%i" b41 F)) + (bcStrings (15 "-0.39 - 0.23*%i" b42 F)) + (text . "\newline \tab{2} ") + (bcStrings (15 "1.13 + 0.83*%i" b51 F)) + (bcStrings (15 "-1.13 + 0.77*%i" b52 F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Enter values of \theta (if required): ") + (text . "\newline \tab{2} ") + (bcStrings (15 "0.0" z1 F)) + (bcStrings (15 "0.0" z2 F)) + (bcStrings (15 "0.0" z3 F)) + (text . "\blankline ")) + htMakeDoneButton('"Continue",'f01rdfGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'m,m) +-- htpSetProperty(page,'lda,lda) +-- htpSetProperty(page,'ldb,ldb) + htpSetProperty(page,'ncolb,ncolb) + htpSetProperty(page,'trans,trans) + htpSetProperty(page,'wheret,wheret) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +f01rdfGen htPage == + n := htpProperty(htPage,'n) + m := htpProperty(htPage,'m) +-- lda := htpProperty(htPage,'lda) +-- ldb := htpProperty(htPage,'ldb) + lda := m + ldb := m + ncolb := htpProperty(htPage,'ncolb) + trans := htpProperty(htPage,'trans) + wheret := htpProperty(htPage,'wheret) + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + for i in 1..n repeat + left := STRCONC((first y).1," ") + y := rest y + zetalist := [left,:zetalist] + zetastring := bcwords2liststring zetalist + y := REVERSE y + for i in 1..lda repeat + for j in 1..n repeat + elm := STRCONC((first y).1," ") + rowList := [:rowList,elm] + y := rest y + matform := [:matform,rowList] + rowList := [] + matstring := bcwords2liststring [bcwords2liststring x for x in matform] + for i in 1..ldb repeat + for j in 1..ncolb repeat + elm := STRCONC((first y).1," ") + rowList := [:rowList,elm] + y := rest y + bform := [:bform,rowList] + rowList := [] + bstring := bcwords2liststring [bcwords2liststring x for x in bform] + prefix := STRCONC('"f01rdf(_"",trans,"_",_"",wheret,"_",",STRINGIMAGE m,", ") + prefix := STRCONC(prefix,STRINGIMAGE n,", ",matstring,", ",STRINGIMAGE lda) + prefix := STRCONC(prefix,",[",zetastring,"],",STRINGIMAGE ncolb,", ") + prefix := STRCONC(prefix,STRINGIMAGE ldb,", ",bstring,", ",STRINGIMAGE ifail,")") + linkGen prefix + + +f01ref() == + htInitPage('"F01REF - Operations with unitary matrices, form columns of {\it Q} after factorization by F01RCF",nil) + htMakePage '( + (domainConditions + (isDomain F (Float)) + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXf01ref} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f01ref| '|NagMatrixOperationsPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\newline ") + (text . "Returns the first {\it ncolq} columns of the real {\it m} by ") + (text . "{\it m} unitary matrix {\it Q}, where {\it Q} is assumed ") + (text . "to be given by {\it Q = }\htbitmap{f01rdf1}, ") + (text . "\htbitmap{f01qdf2} being given in the form ") + (text . "\htbitmap{f01qcf1}, ") + (text . "where \htbitmap{f01rdf2}, ") + (text . "\htbitmap{f01qcf3}, ") + (text . "\htbitmap{gammak} is a scalar for which Re ") + (text . "\htbitmap{gammak} = 1.0, \htbitmap{zetak} ") + (text . "is a real scalar and \htbitmap{zk} is an ") + (text . "(m-k) element vector. ") + (text . "The routine is intended for use following F01RCF or F01RFF. ") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline Rows of matrix A, {\it m}: ") + (text . "\tab{32} \menuitemstyle{} \tab{34} ") + (text . "Columns of matrix A, {\it n}: \newline \tab{2} ") + (bcStrings (6 5 m PI)) + (text . "\tab{34} ") + (bcStrings (6 3 n PI)) +-- (text . "\blankline ") +-- (text . "\newline ") +-- (text . "\menuitemstyle{} \tab{2} ") +-- (text . "\newline First dimension of A, {\it lda} ") +-- (text . "\htbitmap{great=} m: ") +-- (text . "\newline \tab{2} ") +-- (bcStrings (6 5 lda PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Required number of columns of matrix Q {\it ncolq}: ") + (text . "\newline \tab{2} ") + (bcStrings (6 2 ncolq PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Where the elements can be found: ") + (radioButtons wheret + (" " " the elements of \theta are in THETA" seperate) + (" " " the elements of \theta are in A" in_a)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Ifail value: ") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'f01refSolve) + htShowPage() + +f01refSolve htPage == + m := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) + objValUnwrap htpLabelSpadValue(htPage, 'm) + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + lda := m +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lda) +-- objValUnwrap htpLabelSpadValue(htPage, 'lda) + ncolq := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ncolq) + objValUnwrap htpLabelSpadValue(htPage, 'ncolq) + elements := htpButtonValue(htPage,'wheret) + wheret := + elements = 'in_a => '"i" + '"s" + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + ((m = '5 and n = '3) and ncolq = '2) => f01refDefaultSolve(htPage,lda,wheret,ifail) + matList := + "append"/[fa(i,n) for i in 1..lda] where fa(i,n) == + labelList := + "append"/[ga(i,j) for j in 1..n] where ga(i,j) == + anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) + [['bcStrings,[20, "0.0 + 0.0*%i", anam, 'F]]] + prefix := ('"\newline \tab{2} ") + labelList := [['text,:prefix],:labelList] + zList := + "append"/[fz(i) for i in 1..n] where fz(i) == + znam := INTERN STRCONC ('"z",STRINGIMAGE i) + [['bcStrings,[20, "0.0", znam, 'F]]] + prefix := ("\blankline \menuitemstyle{}\tab{2} Enter values of \theta ") + prefix := STRCONC(prefix,"(if required): \newline \tab{2}") + zList := [['text,:prefix],:zList] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :matList,:zList] + page := htInitPage('"F01REF - Operations with unitary matrices, form columns of {\it Q} after factorization by F01RCF",nil) + htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " + htSay '"\newline \tab{2} " + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'f01refGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'m,m) +-- htpSetProperty(page,'lda,lda) + htpSetProperty(page,'ncolq,ncolq) + htpSetProperty(page,'wheret,wheret) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +f01refDefaultSolve (htPage,lda,wheret,ifail) == + n := '3 + m := '5 + ncolq := '2 + page := htInitPage('"F01REF - Operations with unitary matrices, form columns of {\it Q} after factorization by F01RCF",nil) + htMakePage '( + (domainConditions + (isDomain F (Float)) + (isDomain I (Integer))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ") + (text . "\newline \tab{2} ") + (bcStrings (16 "1" a11 F)) + (bcStrings (16 "1 + %i" a12 F)) + (bcStrings (16 "1 + %i" a13 F)) + (text . "\newline \tab{2} ") + (bcStrings (16 "-0.2-0.4*%i" a21 F)) + (bcStrings (16 "-2" a22 F)) + (bcStrings (16 "-1 - %i" a23 F)) + (text . "\newline \tab{2} ") + (bcStrings (16 "-0.32 - 0.16*%i" a31 F)) + (bcStrings (16 "-0.3505+0.263*%i" a32 F)) + (bcStrings (16 "-3" a33 F)) + (text . "\newline \tab{2} ") + (bcStrings (16 "-0.4 + 0.2*%i" a41 F)) + (bcStrings (16 "0.5477*%i" a42 F)) + (bcStrings (16 "0.0" a43 F)) + (text . "\newline \tab{2} ") + (bcStrings (16 "-0.12 + 0.24*%i" a51 F)) + (bcStrings (16 "0.1972+0.2629*%i" a52 F)) + (bcStrings (16 "0.6325" a53 F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Enter values of \theta: ") + (text . "\newline \tab{2} ") + (bcStrings (16 "1 + 0.5*%i" z1 F)) + (bcStrings (16 "1.0954-0.3333*%i" z2 F)) + (bcStrings (16 "1.2649-1.1565*%i" z3 F)) + (text . "\blankline ")) + htMakeDoneButton('"Continue",'f01refGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'m,m) +-- htpSetProperty(page,'lda,lda) + htpSetProperty(page,'ncolq,ncolq) + htpSetProperty(page,'wheret,wheret) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +f01refGen htPage == + n := htpProperty(htPage,'n) + m := htpProperty(htPage,'m) +-- lda := htpProperty(htPage,'lda) + lda := m + ncolq := htpProperty(htPage,'ncolq) + wheret := htpProperty(htPage,'wheret) + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + for i in 1..n repeat + left := STRCONC((first y).1," ") + y := rest y + thetalist := [left,:thetalist] + thetastring := bcwords2liststring thetalist + y := REVERSE y + for i in 1..lda repeat + for j in 1..n repeat + elm := STRCONC((first y).1," ") + rowList := [:rowList,elm] + y := rest y + matform := [:matform,rowList] + rowList := [] + matstring := bcwords2liststring [bcwords2liststring x for x in matform] + prefix := STRCONC('"f01ref(_"",wheret,"_",",STRINGIMAGE m,", ") + prefix := STRCONC(prefix,STRINGIMAGE n,", ",STRINGIMAGE ncolq,", ") + prefix := STRCONC(prefix,STRINGIMAGE lda,",[",thetastring,"],") + prefix := STRCONC(prefix,matstring,", ",STRINGIMAGE ifail,")") + linkGen prefix + diff --git a/src/interp/nag-f01.boot.pamphlet b/src/interp/nag-f01.boot.pamphlet deleted file mode 100644 index 43c8b303..00000000 --- a/src/interp/nag-f01.boot.pamphlet +++ /dev/null @@ -1,2254 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp nag-f01.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. - -@ -<<*>>= -<> - -)package "BOOT" - -f01brf() == - htInitPage("F01BRF - LU factorization of real sparse matrix",nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXf01brf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f01brf| '|NagMatrixOperationsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "Factorizes a real sparse matrix A of order n. The routine forms ") - (text . "the {\it LU} factorization of the entire matrix, or ,") - (text . "optionally, first permutes the matrix to block lower ") - (text . "triangular form and then only factorizes the diagonal block. ") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the order {\em n} of the matrix A ") - (text . "\htbitmap{great=} 1:") - (text . "\newline\tab{2} ") - (bcStrings (8 6 n PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Number of non-zero elements {\it nz}:") - (text . "\tab{32} \menuitemstyle{}\tab{34}") - (text . "{\it pivot}:") - (text . "\newline \tab{2} ") - (bcStrings (8 15 nz PI)) - (text . "\tab{34} ") - (bcStrings (8 "0.1" pivot PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Dimension of A & ICN {\it licn}:") - (text . "\tab{32} \menuitemstyle{}\tab{34}") - (text . "Dimension of IRN {\it lirn}:") - (text . "\newline \tab{2} ") - (bcStrings (6 150 licn PI)) - (text . "\tab{34} ") - (bcStrings (6 75 lirn PI)) - (text . "\blankline") - (text . "\menuitemstyle{}\tab{2} Grow value:") - (radioButtons grow - ("" " True" gr_true) - ("" " False" gr_false)) - (text . "\blankline") - (text . "\menuitemstyle{}\tab{2} Lblock value:") - (radioButtons lblock - ("" " True" lb_true) - ("" " False" lb_false)) - (text . "\blankline ") - (text . "\newline \tab{2} ") - (text . "Ifail is input in three components: ") - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "{\it a} ") - (radioButtons afail - ("" " 0, hard failure" azero) - ("" " 1, soft failure" aone)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "{\it b} ") - (radioButtons bfail - ("" " 1, print error messages" bone) - ("" " 0, suppress error messages" bzero)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "{\it c} ") - (radioButtons cfail - ("" " 1, print warning messages" cone) - ("" " 0, suppress warning messages" czero))) - htMakeDoneButton('"Continue", 'f01brfSolve) - htShowPage() - -f01brfSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - nz := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nz) - objValUnwrap htpLabelSpadValue(htPage, 'nz) - licn := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'licn) - objValUnwrap htpLabelSpadValue(htPage, 'licn) - lirn := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lirn) - objValUnwrap htpLabelSpadValue(htPage, 'lirn) - pivot := htpLabelInputString(htPage, 'pivot) - gr := htpButtonValue(htPage,'grow) - grow := - gr = 'gr_true => '"true" - '"false" - lb := htpButtonValue(htPage,'lblock) - lblock := - lb = 'lb_true => '"true" - '"false" - aerror := htpButtonValue(htPage,'afail) - afail := - aerror = 'azero => '0 - '1 - berror := htpButtonValue(htPage,'bfail) - bfail := - berror = 'bone => '1 - '0 - cerror := htpButtonValue(htPage,'cfail) - cfail := - cerror = 'cone => '1 - '0 - ifail := 100*cfail + 10*bfail + afail - ((n = '6 and nz = '15) and (licn = '150 and lirn = '75)) - => f01brfDefaultSolve(htPage,pivot,grow,lblock,ifail) - labelList := - "append"/[f(i) for i in 1..nz] where f(i) == - prefix := ('"\newline \tab{2} ") - anam := INTERN STRCONC ('"a",STRINGIMAGE i) - mid := ('"\tab{32} ") - rnam := INTERN STRCONC ('"irn",STRINGIMAGE i) - end := ('"\tab{42} ") - cnam := INTERN STRCONC ('"icn",STRINGIMAGE i) - [['text,:prefix],['bcStrings,[8, 0.0, anam, 'F]], - ['text,:mid],['bcStrings,[4, 0, rnam, 'PI]], - ['text,:end],['bcStrings,[4, 0, cnam, 'PI]]] - abortList := - [['bcStrings,[6, '"true", 'abortone, 'EM]], - ['bcStrings,[6, '"true", 'aborttwo, 'EM]], - ['bcStrings,[6, '"false", 'abortthree, 'EM]], - ['bcStrings,[6, '"true", 'abortfour, 'EM]]] - prefix := ('"\blankline \menuitemstyle{}\tab{2} Abort: ") - abortList := [['text,:prefix],:abortList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain EM ($EmptyMode)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :labelList,:abortList] - page := htInitPage("F01BRF - LU factorization of real sparse matrix",nil) - htSay '"\menuitemstyle{}\tab{2} Non-zero elements of A: " - htSay '"\tab{30} \menuitemstyle{}\tab{32} Row: " - htSay '"\tab{40} \menuitemstyle{}\tab{42} Column: " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'f01brfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'nz,nz) - htpSetProperty(page,'licn,licn) - htpSetProperty(page,'lirn,lirn) - htpSetProperty(page,'pivot,pivot) - htpSetProperty(page,'grow,grow) - htpSetProperty(page,'lblock,lblock) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -f01brfDefaultSolve(htPage,pivot,grow,lblock,ifail) == - n := '6 - nz := '15 - licn := '150 - lirn := '75 - page := htInitPage("F01BRF - LU factorization of real sparse matrix",nil) - htMakePage '( - (domainConditions - (isDomain PI (Positive Integer)) - (isDomain EM $EmptyMode) - (isDomain F (Float))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Non-zero elements of A: ") - (text . "\tab{30} \menuitemstyle{}\tab{32} Row: ") - (text . "\tab{40} \menuitemstyle{}\tab{42} Column: ") - (text . "\newline \tab{2}") - (bcStrings (8 "5.0" a1 F)) - (text . "\tab{32} ") - (bcStrings (4 1 irn1 PI)) - (text . "\tab{42} ") - (bcStrings (4 1 icn1 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "2.0" a2 F)) - (text . "\tab{32} ") - (bcStrings (4 2 irn2 PI)) - (text . "\tab{42} ") - (bcStrings (4 2 icn2 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "-1.0" a3 F)) - (text . "\tab{32} ") - (bcStrings (4 2 irn3 PI)) - (text . "\tab{42} ") - (bcStrings (4 3 icn3 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "2.0" a4 F)) - (text . "\tab{32} ") - (bcStrings (4 2 irn4 PI)) - (text . "\tab{42} ") - (bcStrings (4 4 icn4 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "3.0" a5 F)) - (text . "\tab{32} ") - (bcStrings (4 3 irn5 PI)) - (text . "\tab{42} ") - (bcStrings (4 3 icn5 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "-2.0" a6 F)) - (text . "\tab{32} ") - (bcStrings (4 4 irn6 PI)) - (text . "\tab{42} ") - (bcStrings (4 1 icn6 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "1.0" a7 F)) - (text . "\tab{32} ") - (bcStrings (4 4 irn7 PI)) - (text . "\tab{42} ") - (bcStrings (4 4 icn7 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "1.0" a8 F)) - (text . "\tab{32} ") - (bcStrings (4 4 irn8 PI)) - (text . "\tab{42} ") - (bcStrings (4 5 icn8 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "-1.0" a9 F)) - (text . "\tab{32} ") - (bcStrings (4 5 irn9 PI)) - (text . "\tab{42} ") - (bcStrings (4 1 icn9 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "-1.0" a10 F)) - (text . "\tab{32} ") - (bcStrings (4 5 irn10 PI)) - (text . "\tab{42} ") - (bcStrings (4 4 icn10 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "2.0" a11 F)) - (text . "\tab{32} ") - (bcStrings (4 5 irn11 PI)) - (text . "\tab{42} ") - (bcStrings (4 5 icn11 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "-3.0" a12 F)) - (text . "\tab{32} ") - (bcStrings (4 5 irn12 PI)) - (text . "\tab{42} ") - (bcStrings (4 6 icn12 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "-1.0" a13 F)) - (text . "\tab{32} ") - (bcStrings (4 6 irn13 PI)) - (text . "\tab{42} ") - (bcStrings (4 1 icn13 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "-1.0" a14 F)) - (text . "\tab{32} ") - (bcStrings (4 6 irn14 PI)) - (text . "\tab{42} ") - (bcStrings (4 2 icn14 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "6.0" a15 F)) - (text . "\tab{32} ") - (bcStrings (4 6 irn15 PI)) - (text . "\tab{42} ") - (bcStrings (4 6 icn15 PI)) - (text . "\blankline ") - (text . "\menuitemstyle{} \tab{2} Abort :") - (bcStrings (8 "true" abort_one EM)) - (bcStrings (8 "true" abort_two EM)) - (bcStrings (8 "false" abort_three EM)) - (bcStrings (8 "true" abort_four EM))) - htMakeDoneButton('"Continue",'f01brfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'nz,nz) - htpSetProperty(page,'licn,licn) - htpSetProperty(page,'lirn,lirn) - htpSetProperty(page,'pivot,pivot) - htpSetProperty(page,'grow,grow) - htpSetProperty(page,'lblock,lblock) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f01brfGen htPage == - n := htpProperty(htPage,'n) - nz := htpProperty(htPage,'nz) - licn := htpProperty(htPage,'licn) - lirn := htpProperty(htPage,'lirn) - pivot := htpProperty(htPage,'pivot) - grow := htpProperty(htPage,'grow) - lblock := htpProperty(htPage,'lblock) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - for i in 1..4 repeat - abort := STRCONC((first y).1," ") - y := rest y - abortList := [abort,:abortList] - astring := bcwords2liststring abortList - while y repeat - end := STRCONC ((first y).1," ") - y := rest y - mid := STRCONC ((first y).1," ") - y := rest y - top := STRCONC ((first y).1," ") - y := rest y - cList := [end,:cList] - rList := [mid,:rList] - matList := [top,:matList] - for i in 1..(licn-nz) repeat - cList := [:cList,'"0 "] - matList := [:matList,'"0 "] - for i in 1..(lirn-nz) repeat - rList := [:rList,'"0 "] - cstring := bcwords2liststring cList - rstring := bcwords2liststring rList - matstring := bcwords2liststring matList - prefix := STRCONC('"f01brf(",STRINGIMAGE n,", ",STRINGIMAGE nz,", ") - prefix := STRCONC(prefix,STRINGIMAGE licn,", ",STRINGIMAGE lirn,", ",pivot) - prefix := STRCONC(prefix,", ",lblock,", ",grow,", ",astring,",[",matstring) - prefix := STRCONC(prefix,"],[",rstring,"],[",cstring,"], ") - linkGen STRCONC(prefix,STRINGIMAGE ifail,")") - -f01bsf() == - htInitPage("F01BSF - LU factorization of real sparse matrix with known sparsity pattern",nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXf01bsf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f01bsf| '|NagMatrixOperationsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "Factorizes a real sparse matrix A of order n using the pivotal ") - (text . "sequence previously obtained by F01BRF when a matrix of the ") - (text . "same sparsity pattern was factorized. ") - (text . "\blankline ") - (text . "Read the input file to see the example program. ") - (text . "\spadpaste{)read f01bsf \bound{s0}} ") - (text . "\blankline") - (text . "\newline ")) - htShowPage() - -f01maf() == - htInitPage("F01MAF - \htbitmap{llt} factorization of real sparse symmetric positive-definite matrix",nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXf01maf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f01maf| '|NagMatrixOperationsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "Computes an incomplete Cholesky factorization of a real ") - (text . "sparse symmetric positive-definite matrix A of order n. ") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the order {\em n} of the matrix A ") - (text . "\htbitmap{great=} 1:") - (text . "\newline\tab{2} ") - (bcStrings (8 16 n PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Number of non-zero elements {\it nz}:") - (text . "\newline \tab{2} ") - (bcStrings (8 40 nz PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Dimension of A & ICN {\it licn}:") - (text . "\tab{32} \menuitemstyle{}\tab{34}") - (text . "Dimension of IRN {\it lirn}:") - (text . "\newline \tab{2} ") - (bcStrings (6 90 licn PI)) - (text . "\tab{34} ") - (bcStrings (6 50 lirn PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Tolerance {\it droptl}: ") - (text . "\tab{32} \menuitemstyle{}\tab{34}") - (text . "{\it densw}:") - (text . "\newline \tab{2} ") - (bcStrings (6 "0.1" droptl F)) - (text . "\tab{34} ") - (bcStrings (6 "0.8" densw F)) - (text . "\blankline ") - (text . "\newline \tab{2} ") - (text . "Ifail is input in three components: ") - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "{\it a} ") - (radioButtons afail - ("" " 0, hard failure" azero) - ("" " 1, soft failure" aone)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "{\it b} ") - (radioButtons bfail - ("" " 1, print error messages" bone) - ("" " 0, suppress error messages" bzero)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "{\it c} ") - (radioButtons cfail - ("" " 1, print warning messages" cone) - ("" " 0, suppress warning messages" czero))) - htMakeDoneButton('"Continue", 'f01mafSolve) - htShowPage() - -f01mafSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - nz := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nz) - objValUnwrap htpLabelSpadValue(htPage, 'nz) - licn := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'licn) - objValUnwrap htpLabelSpadValue(htPage, 'licn) - lirn := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lirn) - objValUnwrap htpLabelSpadValue(htPage, 'lirn) - aerror := htpButtonValue(htPage,'afail) - afail := - aerror = 'azero => '0 - '1 - berror := htpButtonValue(htPage,'bfail) - bfail := - berror = 'bone => '1 - '0 - cerror := htpButtonValue(htPage,'cfail) - cfail := - cerror = 'cone => '1 - '0 - ifail := 100*cfail + 10*bfail + afail - droptl := htpLabelInputString(htPage, 'droptl) - densw := htpLabelInputString(htPage, 'densw) - ((n = '16 and nz = '40) and (licn = '90 and lirn = '50)) - => f01mafDefaultSolve(htPage,droptl,densw,ifail) - labelList := - "append"/[f(i) for i in 1..nz] where f(i) == - prefix := ('"\newline \tab{2} ") - anam := INTERN STRCONC ('"a",STRINGIMAGE i) - mid := ('"\tab{32} ") - rnam := INTERN STRCONC ('"irn",STRINGIMAGE i) - end := ('"\tab{42} ") - cnam := INTERN STRCONC ('"icn",STRINGIMAGE i) - [['text,:prefix],['bcStrings,[8, 0.0, anam, 'F]], - ['text,:mid],['bcStrings,[4, 0, rnam, 'PI]], - ['text,:end],['bcStrings,[4, 0, cnam, 'PI]]] - abortList := - [['bcStrings,[6, '"true", 'abortone, 'EM]], - ['bcStrings,[6, '"true", 'aborttwo, 'EM]], - ['bcStrings,[6, '"true", 'abortthree, 'EM]]] - prefix := ('"\blankline \menuitemstyle{}\tab{2} Abort: ") - abortList := [['text,:prefix],:abortList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain EM ($EmptyMode)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :labelList,:abortList] - page := htInitPage("F01MAF - \htbitmap{llt} factorization of real sparse symmetric positive-definite matrix",nil) - htSay '"\menuitemstyle{}\tab{2} Non-zero elements of A: " - htSay '"\tab{30} \menuitemstyle{}\tab{32} Row: " - htSay '"\tab{40} \menuitemstyle{}\tab{42} Column: " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'f01mafGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'nz,nz) - htpSetProperty(page,'licn,licn) - htpSetProperty(page,'lirn,lirn) - htpSetProperty(page,'droptl,droptl) - htpSetProperty(page,'densw,densw) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -f01mafDefaultSolve(htPage,droptl,densw,ifail) == - n := '16 - nz := '40 - licn := '90 - lirn := '50 - page := htInitPage("F01MAF - \htbitmap{llt} factorization of real sparse symmetric positive-definite matrix",nil) - htMakePage '( - (domainConditions - (isDomain PI (Positive Integer)) - (isDomain EM $EmptyMode) - (isDomain F (Float))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Non-zero elements of A: ") - (text . "\tab{30} \menuitemstyle{}\tab{32} Row: ") - (text . "\tab{40} \menuitemstyle{}\tab{42} Column: ") - (text . "\newline \tab{2}") - (bcStrings (8 "1.0" a1 F)) - (text . "\tab{32} ") - (bcStrings (4 1 irn1 PI)) - (text . "\tab{42} ") - (bcStrings (4 1 icn1 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "1.0" a2 F)) - (text . "\tab{32} ") - (bcStrings (4 2 irn2 PI)) - (text . "\tab{42} ") - (bcStrings (4 2 icn2 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "1.0" a3 F)) - (text . "\tab{32} ") - (bcStrings (4 3 irn3 PI)) - (text . "\tab{42} ") - (bcStrings (4 3 icn3 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "1.0" a4 F)) - (text . "\tab{32} ") - (bcStrings (4 4 irn4 PI)) - (text . "\tab{42} ") - (bcStrings (4 4 icn4 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "1.0" a5 F)) - (text . "\tab{32} ") - (bcStrings (4 5 irn5 PI)) - (text . "\tab{42} ") - (bcStrings (4 5 icn5 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "1.0" a6 F)) - (text . "\tab{32} ") - (bcStrings (4 6 irn6 PI)) - (text . "\tab{42} ") - (bcStrings (4 6 icn6 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "1.0" a7 F)) - (text . "\tab{32} ") - (bcStrings (4 7 irn7 PI)) - (text . "\tab{42} ") - (bcStrings (4 7 icn7 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "1.0" a8 F)) - (text . "\tab{32} ") - (bcStrings (4 8 irn8 PI)) - (text . "\tab{42} ") - (bcStrings (4 8 icn8 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "1.0" a9 F)) - (text . "\tab{32} ") - (bcStrings (4 9 irn9 PI)) - (text . "\tab{42} ") - (bcStrings (4 9 icn9 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "1.0" a10 F)) - (text . "\tab{32} ") - (bcStrings (4 10 irn10 PI)) - (text . "\tab{42} ") - (bcStrings (4 10 icn10 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "1.0" a11 F)) - (text . "\tab{32} ") - (bcStrings (4 11 irn11 PI)) - (text . "\tab{42} ") - (bcStrings (4 11 icn11 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "1.0" a12 F)) - (text . "\tab{32} ") - (bcStrings (4 12 irn12 PI)) - (text . "\tab{42} ") - (bcStrings (4 12 icn12 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "1.0" a13 F)) - (text . "\tab{32} ") - (bcStrings (4 13 irn13 PI)) - (text . "\tab{42} ") - (bcStrings (4 13 icn13 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "1.0" a14 F)) - (text . "\tab{32} ") - (bcStrings (4 14 irn14 PI)) - (text . "\tab{42} ") - (bcStrings (4 14 icn14 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "1.0" a15 F)) - (text . "\tab{32} ") - (bcStrings (4 15 irn15 PI)) - (text . "\tab{42} ") - (bcStrings (4 15 icn15 PI)) - (text . "\blankline ") - (text . "\newline \tab{2}") - (bcStrings (8 "1.0" a16 F)) - (text . "\tab{32} ") - (bcStrings (4 16 irn16 PI)) - (text . "\tab{42} ") - (bcStrings (4 16 icn16 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "-0.25" a17 F)) - (text . "\tab{32} ") - (bcStrings (4 1 irn17 PI)) - (text . "\tab{42} ") - (bcStrings (4 2 icn17 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "-0.25" a18 F)) - (text . "\tab{32} ") - (bcStrings (4 2 irn18 PI)) - (text . "\tab{42} ") - (bcStrings (4 3 icn18 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "-0.25" a19 F)) - (text . "\tab{32} ") - (bcStrings (4 3 irn19 PI)) - (text . "\tab{42} ") - (bcStrings (4 4 icn19 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "-0.25" a20 F)) - (text . "\tab{32} ") - (bcStrings (4 5 irn20 PI)) - (text . "\tab{42} ") - (bcStrings (4 6 icn20 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "-0.25" a21 F)) - (text . "\tab{32} ") - (bcStrings (4 6 irn21 PI)) - (text . "\tab{42} ") - (bcStrings (4 7 icn21 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "-0.25" a22 F)) - (text . "\tab{32} ") - (bcStrings (4 7 irn22 PI)) - (text . "\tab{42} ") - (bcStrings (4 8 icn22 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "-0.25" a23 F)) - (text . "\tab{32} ") - (bcStrings (4 9 irn23 PI)) - (text . "\tab{42} ") - (bcStrings (4 10 icn23 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "-0.25" a24 F)) - (text . "\tab{32} ") - (bcStrings (4 10 irn24 PI)) - (text . "\tab{42} ") - (bcStrings (4 11 icn24 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "-0.25" a25 F)) - (text . "\tab{32} ") - (bcStrings (4 11 irn25 PI)) - (text . "\tab{42} ") - (bcStrings (4 12 icn25 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "-0.25" a26 F)) - (text . "\tab{32} ") - (bcStrings (4 13 irn26 PI)) - (text . "\tab{42} ") - (bcStrings (4 14 icn26 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "-0.25" a27 F)) - (text . "\tab{32} ") - (bcStrings (4 14 irn27 PI)) - (text . "\tab{42} ") - (bcStrings (4 15 icn27 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "-0.25" a28 F)) - (text . "\tab{32} ") - (bcStrings (4 15 irn28 PI)) - (text . "\tab{42} ") - (bcStrings (4 16 icn28 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "-0.25" a29 F)) - (text . "\tab{32} ") - (bcStrings (4 1 irn29 PI)) - (text . "\tab{42} ") - (bcStrings (4 5 icn29 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "-0.25" a30 F)) - (text . "\tab{32} ") - (bcStrings (4 2 irn30 PI)) - (text . "\tab{42} ") - (bcStrings (4 6 icn30 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "-0.25" a31 F)) - (text . "\tab{32} ") - (bcStrings (4 3 irn31 PI)) - (text . "\tab{42} ") - (bcStrings (4 7 icn31 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "-0.25" a32 F)) - (text . "\tab{32} ") - (bcStrings (4 4 irn32 PI)) - (text . "\tab{42} ") - (bcStrings (4 8 icn32 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "-0.25" a33 F)) - (text . "\tab{32} ") - (bcStrings (4 5 irn33 PI)) - (text . "\tab{42} ") - (bcStrings (4 9 icn33 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "-0.25" a34 F)) - (text . "\tab{32} ") - (bcStrings (4 6 irn34 PI)) - (text . "\tab{42} ") - (bcStrings (4 10 icn34 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "-0.25" a35 F)) - (text . "\tab{32} ") - (bcStrings (4 7 irn35 PI)) - (text . "\tab{42} ") - (bcStrings (4 11 icn35 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "-0.25" a36 F)) - (text . "\tab{32} ") - (bcStrings (4 8 irn36 PI)) - (text . "\tab{42} ") - (bcStrings (4 12 icn36 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "-0.25" a37 F)) - (text . "\tab{32} ") - (bcStrings (4 9 irn37 PI)) - (text . "\tab{42} ") - (bcStrings (4 13 icn37 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "-0.25" a38 F)) - (text . "\tab{32} ") - (bcStrings (4 10 irn38 PI)) - (text . "\tab{42} ") - (bcStrings (4 14 icn38 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "-0.25" a39 F)) - (text . "\tab{32} ") - (bcStrings (4 11 irn39 PI)) - (text . "\tab{42} ") - (bcStrings (4 15 icn39 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "-0.25" a40 F)) - (text . "\tab{32} ") - (bcStrings (4 12 irn40 PI)) - (text . "\tab{42} ") - (bcStrings (4 16 icn40 PI)) - (text . "\blankline ") - (text . "\menuitemstyle{} \tab{2} Abort :") - (bcStrings (8 "true" abort_one EM)) - (bcStrings (8 "true" abort_two EM)) - (bcStrings (8 "true" abort_three EM))) - htMakeDoneButton('"Continue",'f01mafGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'nz,nz) - htpSetProperty(page,'licn,licn) - htpSetProperty(page,'lirn,lirn) - htpSetProperty(page,'droptl,droptl) - htpSetProperty(page,'densw,densw) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f01mafGen htPage == - n := htpProperty(htPage,'n) - nz := htpProperty(htPage,'nz) - licn := htpProperty(htPage,'licn) - lirn := htpProperty(htPage,'lirn) - droptl := htpProperty(htPage,'droptl) - densw := htpProperty(htPage,'densw) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - for i in 1..3 repeat - abort := STRCONC((first y).1," ") - y := rest y - abortList := [abort,:abortList] - astring := bcwords2liststring abortList - while y repeat - end := STRCONC ((first y).1," ") - y := rest y - mid := STRCONC ((first y).1," ") - y := rest y - top := STRCONC ((first y).1," ") - y := rest y - cList := [end,:cList] - rList := [mid,:rList] - matList := [top,:matList] - for i in 1..(licn-nz) repeat - cList := [:cList,'"0 "] - matList := [:matList,'"0 "] - for i in 1..(lirn-nz) repeat - rList := [:rList,'"0 "] - cstring := bcwords2liststring cList - rstring := bcwords2liststring rList - matstring := bcwords2liststring matList - prefix := STRCONC('"f01maf(",STRINGIMAGE n,", ",STRINGIMAGE nz,", ") - prefix := STRCONC(prefix,STRINGIMAGE licn,", ",STRINGIMAGE lirn,", ") - prefix := STRCONC(prefix,astring,",[",matstring) - prefix := STRCONC(prefix,"],[",rstring,"],[",cstring,"], ",droptl,", ",densw) - linkGen STRCONC(prefix,", ",STRINGIMAGE ifail,")") - - - - -f01mcf() == - htInitPage("F01MCF - \htbitmap{ldlt} factorization of real symmetric positive-definite variable-bandwidth matrix",nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXf01mcf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f01mcf| '|NagMatrixOperationsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "Computes the Cholesky factorization of a real symmetric positive") - (text . "-definite variable-bandwidth matrix {\it A} or order {\it n}. ") - (text . "That is, {\it A = }\htbitmap{ldlt}, where {\it L} is ") - (text . "a unit lower triangular matrix and {\it D} is a diagonal matrix.") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the order {\em n} of the matrix A ") - (text . "\htbitmap{great=} 1:") - (text . "\newline\tab{2} ") - (bcStrings (9 6 n PI)) - (text . "\blankline") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "\newline Enter the number of elements: ") - (text . "\newline\tab{2} ") - (bcStrings (9 14 lal 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", 'f01mcfSolve) - htShowPage() - -f01mcfSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - lal := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lal) - objValUnwrap htpLabelSpadValue(htPage, 'lal) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - (n = '6 and lal = '14) => f01mcfDefaultSolve(htPage,ifail) - labelList := - "append"/[f(i) for i in 1..lal] where f(i) == - xnam := INTERN STRCONC ('"x",STRINGIMAGE i) - [['bcStrings,[6, 0.0, xnam, 'F]]] - nrowList := - "append"/[g(j) for j in 1..n] where g(j) == - nam := INTERN STRCONC ('"n",STRINGIMAGE j) - [['bcStrings,[6, 0, nam, 'PI]]] - prefix := ('"\blankline \menuitemstyle{}\tab{2} {\it NROW(n)} the width ") - prefix := STRCONC(prefix,"of the ith row of A: \newline \tab{2} ") - nrowList := [['text,:prefix],:nrowList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :labelList,:nrowList] - page := htInitPage("F01MCF - \htbitmap{ldlt} factorization of real symmetric positive-definite variable-bandwidth matrix",nil) - htSay '"\menuitemstyle{}\tab{2} Elements of matrix {\it A} in row by row " - htSay '"order: \newline \tab{2} " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'f01mcfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'lal,lal) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -f01mcfDefaultSolve (htPage,ifail) == - n := '6 - lal := '14 - page := htInitPage("F01MCF - \htbitmap{ldlt} factorization of real symmetric positive-definite variable-bandwidth matrix",nil) - htMakePage '( - (domainConditions - (isDomain PI (Positive Integer)) - (isDomain F (Float))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Elements of matrix {\it A} in row by ") - (text . "row order: ") - (text . "\newline ") - (bcStrings (6 "1.0" x1 F)) - (bcStrings (6 "2.0" x2 F)) - (bcStrings (6 "5.0" x3 F)) - (bcStrings (6 "3.0" x4 F)) - (bcStrings (6 "13.0" x5 F)) - (bcStrings (6 "16.0" x6 F)) - (bcStrings (6 "5.0" x7 F)) - (bcStrings (6 "14.0" x8 F)) - (bcStrings (6 "18.0" x9 F)) - (bcStrings (6 "8.0" x10 F)) - (bcStrings (6 "55.0" x11 F)) - (bcStrings (6 "24.0" x12 F)) - (bcStrings (6 "17.0" x13 F)) - (bcStrings (6 "77.0" x14 F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} {\it NROW(n)} the width of the ith row ") - (text . "of A: ") - (text . "\newline ") - (bcStrings (6 1 n1 PI)) - (bcStrings (6 2 n2 PI)) - (bcStrings (6 2 n3 PI)) - (bcStrings (6 1 n4 PI)) - (bcStrings (6 5 n5 PI)) - (bcStrings (6 3 n6 PI)) - (text . "\blankline ")) - htMakeDoneButton('"Continue",'f01mcfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'lal,lal) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f01mcfGen htPage == - n := htpProperty(htPage,'n) - lal := htpProperty(htPage,'lal) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - for i in 1..n repeat - right := STRCONC ((first y).1," ") - y := rest y - nrowList := [right,:nrowList] - nrowstring := bcwords2liststring nrowList - while y repeat - right := STRCONC ((first y).1," ") - y := rest y - matList := [right,:matList] - matstring := bcwords2liststring matList - prefix := STRCONC('"f01mcf(",STRINGIMAGE n,", [",matstring,"], ") - prefix := STRCONC(prefix,STRINGIMAGE lal,", [",nrowstring,"], ") - linkGen STRCONC(prefix,STRINGIMAGE ifail,")") - - -f01qcf() == - htInitPage('"F01QCF - QR factorization or real m by n matrix (m \htbitmap{great=} n)",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXf01qcf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f01qcf| '|NagMatrixOperationsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "Finds the QR factorization of a real {\it m} by {it n} ({\it m ") - (text . "\htbitmap{great=} n}) matrix {\it A}, which ") - (text . "is factorized as \htbitmap{f01qcf}, ") - (text . "where {\it m > n} and {\it A = QR } when {\it m = n }, where ") - (text . "{\it Q} is an {\it m} by {\it m } orthogonal matrix and {\it R} ") - (text . "is an {\it n} by {\it n} upper triangular matrix. The {\it k}th ") - (text . "transformation matrix,{\it Qk}, ") - (text . "which is used to introduce zeros into the {\it k}th column of ") - (text . "{\it A}, is given in the form ") - (text . "\htbitmap{f01qcf1}, ") - (text . "where \htbitmap{f01qcf2}, ") - (text . "\htbitmap{f01qcf3}, ") - (text . "\htbitmap{zetak} is a scalar and ") - (text . "\htbitmap{zk} is an (m-k) element vector. ") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline Rows of matrix A, {\it m}: ") - (text . "\tab{32} \menuitemstyle{} \tab{34} ") - (text . "Columns of matrix A, {\it n}: \newline \tab{2} ") - (bcStrings (6 5 m PI)) - (text . "\tab{34} ") - (bcStrings (6 3 n PI)) --- (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{} \tab{2} ") --- (text . "\newline First dimension of A, {\it lda} ") --- (text . "\htbitmap{great=} m: ") --- (text . "\newline \tab{2} ") --- (bcStrings (6 5 lda PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'f01qcfSolve) - htShowPage() - -f01qcfSolve htPage == - m := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) - objValUnwrap htpLabelSpadValue(htPage, 'm) - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - lda := m --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lda) --- objValUnwrap htpLabelSpadValue(htPage, 'lda) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - (m = '5 and n = '3) => f01qcfDefaultSolve(htPage,lda,ifail) - matList := - "append"/[f(i,n) for i in 1..lda] where f(i,n) == - labelList := - "append"/[g(i,j) for j in 1..n] where g(i,j) == - anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) - [['bcStrings,[6, "0.0", anam, 'F]]] - prefix := ('"\newline \tab{2} ") - labelList := [['text,:prefix],:labelList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :matList] - page := htInitPage("F01QCF - QR factorization or real m by n matrix (m \htbitmap{great=} n)",nil) - htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " - htSay '"\newline \tab{2} " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'f01qcfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) --- htpSetProperty(page,'lda,lda) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -f01qcfDefaultSolve (htPage,lda,ifail) == - n := '3 - m := '5 - page := htInitPage('"F01QCF - QR factorization or real m by n matrix (m \htbitmap{great=} n)",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 "2.0" a11 F)) - (bcStrings (6 "2.5" a12 F)) - (bcStrings (6 "2.5" a13 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "2.0" a21 F)) - (bcStrings (6 "2.5" a22 F)) - (bcStrings (6 "2.5" a23 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "1.6" a31 F)) - (bcStrings (6 "-0.4" a32 F)) - (bcStrings (6 "2.8" a33 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "2.0" a41 F)) - (bcStrings (6 "-0.5" a42 F)) - (bcStrings (6 "0.5" a43 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "1.2" a51 F)) - (bcStrings (6 "-0.3" a52 F)) - (bcStrings (6 "-2.9" a53 F))) - htMakeDoneButton('"Continue",'f01qcfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) --- htpSetProperty(page,'lda,lda) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f01qcfGen htPage == - n := htpProperty(htPage,'n) - m := htpProperty(htPage,'m) --- lda := htpProperty(htPage,'lda) - lda := m - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - y := REVERSE y - for i in 1..lda repeat - for j in 1..n repeat - elm := STRCONC((first y).1," ") - rowList := [:rowList,elm] - y := rest y - matform := [:matform,rowList] - rowList := [] - matstring := bcwords2liststring [bcwords2liststring x for x in matform] - prefix := STRCONC('"f01qcf(",STRINGIMAGE m,", ",STRINGIMAGE n,", ") - prefix := STRCONC(prefix,STRINGIMAGE lda,", ",matstring,", ") - prefix := STRCONC(prefix,STRINGIMAGE ifail,")") - linkGen prefix - -f01qdf() == - htInitPage('"F01QDF - Operations with orthogonal matrices, compute {\it QB} or \htbitmap{f01qdf} after factorization by F01QCF or F01QDF",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXf01qdf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f01qdf| '|NagMatrixOperationsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "Performs one of the transformations {\it B = QB or B = }") - (text . "\htbitmap{f01qdf}, where {\it B} is a real {\it m} ") - (text . "by {\it ncolb} matrix and {\it Q} is an {\it m} by {\it m} ") - (text . "orthogonal matrix assumed to be given by {\it Q = }") - (text . "\htbitmap{f01qdf1}, \htbitmap{f01qdf2} ") - (text . "being given in the form ") - (text . "\htbitmap{f01qcf1}, ") - (text . "where \htbitmap{f01qcf2}, ") - (text . "\htbitmap{f01qcf3}, ") - (text . "\htbitmap{zetak} is a scalar and ") - (text . "\htbitmap{zk} is an (m-k) element vector. ") - (text . "The routine is intended for use following F01QCF or F01QFF. ") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline Rows of matrix A, {\it m}: ") - (text . "\tab{32} \menuitemstyle{} \tab{34} ") - (text . "Columns of matrix A, {\it n}: \newline \tab{2} ") - (bcStrings (6 5 m PI)) - (text . "\tab{34} ") - (bcStrings (6 3 n PI)) --- (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{} \tab{2} ") --- (text . "\newline First dimension of A, {\it lda} ") --- (text . "\htbitmap{great=} m: ") --- (text . "\tab{32} \menuitemstyle{} \tab{34} ") --- (text . "First dimension of B, {\it ldb} ") --- (text . "\htbitmap{great=} m: ") --- (text . "\newline \tab{2} ") --- (bcStrings (6 5 lda PI)) --- (text . "\tab{34} ") --- (bcStrings (6 5 ldb PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Number of columns of matrix B {\it ncolb}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 2 ncolb PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Transformation to be performed: ") - (radioButtons trans - (" " " {\it B = QB}" no_trans) - (" " " {\it B =} \htbitmap{f01qdf}" trans)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Where the elements can be found: ") - (radioButtons wheret - (" " " the elements of \zeta are in A" in_a) - (" " " the elements of \zeta are in ZETA, returned by F01QCF/F01QFF" seperate)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'f01qdfSolve) - htShowPage() - -f01qdfSolve htPage == - m := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) - objValUnwrap htpLabelSpadValue(htPage, 'm) - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - lda := m --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lda) --- objValUnwrap htpLabelSpadValue(htPage, 'lda) - ldb := m --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ldb) --- objValUnwrap htpLabelSpadValue(htPage, 'ldb) - ncolb := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ncolb) - objValUnwrap htpLabelSpadValue(htPage, 'ncolb) - operation := htpButtonValue(htPage,'trans) - trans := - operation = 'no_trans => '"n" - '"t" - elements := htpButtonValue(htPage,'wheret) - wheret := - elements = 'in_a => '"i" - '"s" - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - ((m = '5 and n = '3) and ncolb = '2) => f01qdfDefaultSolve(htPage,lda,ldb,trans,wheret,ifail) - matList := - "append"/[fa(i,n) for i in 1..lda] where fa(i,n) == - labelList := - "append"/[ga(i,j) for j in 1..n] where ga(i,j) == - anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) - [['bcStrings,[6, "0.0", anam, 'F]]] - prefix := ('"\newline \tab{2} ") - labelList := [['text,:prefix],:labelList] - bList := - "append"/[fb(i,ncolb) for i in 1..ldb] where fb(i,ncolb) == - labelList := - "append"/[gb(i,j) for j in 1..ncolb] where gb(i,j) == - bnam := INTERN STRCONC ('"b",STRINGIMAGE i, STRINGIMAGE j) - [['bcStrings,[6, "0.0", bnam, 'F]]] - prefix := ('"\newline \tab{2} ") - labelList := [['text,:prefix],:labelList] - prefix := ("\blankline \menuitemstyle{}\tab{2} Enter values of {\it B}: ") - bList := [['text,:prefix],:bList] - zList := - "append"/[fz(i) for i in 1..n] where fz(i) == - znam := INTERN STRCONC ('"z",STRINGIMAGE i) - [['bcStrings,[6, "0.0", znam, 'F]]] - prefix := ("\blankline \menuitemstyle{}\tab{2} Enter values of \zeta ") - prefix := STRCONC(prefix,"(if required): \newline \tab{2}") - zList := [['text,:prefix],:zList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :matList,:bList,:zList] - page := htInitPage('"F01QDF - Operations with orthogonal matrices, compute {\it QB} or \htbitmap{f01qdf} after factorization by F01QCF or F01QDF",nil) - htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " - htSay '"\newline \tab{2} " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'f01qdfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) --- htpSetProperty(page,'lda,lda) --- htpSetProperty(page,'ldb,ldb) - htpSetProperty(page,'ncolb,ncolb) - htpSetProperty(page,'trans,trans) - htpSetProperty(page,'wheret,wheret) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -f01qdfDefaultSolve (htPage,lda,ldb,trans,wheret,ifail) == - n := '3 - m := '5 - ncolb := '2 - page := htInitPage('"F01QDF - Operations with orthogonal matrices, compute {\it QB} or \htbitmap{f01qdf} after factorization by F01QCF or F01QDF",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 "2.0" a11 F)) - (bcStrings (6 "2.5" a12 F)) - (bcStrings (6 "2.5" a13 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "2.0" a21 F)) - (bcStrings (6 "2.5" a22 F)) - (bcStrings (6 "2.5" a23 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "1.6" a31 F)) - (bcStrings (6 "-0.4" a32 F)) - (bcStrings (6 "2.8" a33 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "2.0" a41 F)) - (bcStrings (6 "-0.5" a42 F)) - (bcStrings (6 "0.5" a43 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "1.2" a51 F)) - (bcStrings (6 "-0.3" a52 F)) - (bcStrings (6 "-2.9" a53 F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} Enter values of {\it B}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 "1.1" b11 F)) - (bcStrings (6 "0.0" b12 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.9" b21 F)) - (bcStrings (6 "0.0" b22 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.6" b31 F)) - (bcStrings (6 "1.32" b32 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" b41 F)) - (bcStrings (6 "1.1" b42 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "-0.8" b51 F)) - (bcStrings (6 "-0.26" b52 F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter values of \zeta (if required): ") - (text . "\newline \tab{2} ") - (bcStrings (10 "0.0" z1 F)) - (bcStrings (10 "0.0" z2 F)) - (bcStrings (10 "0.0" z3 F)) - (text . "\blankline ")) - htMakeDoneButton('"Continue",'f01qdfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) --- htpSetProperty(page,'lda,lda) --- htpSetProperty(page,'ldb,ldb) - htpSetProperty(page,'ncolb,ncolb) - htpSetProperty(page,'trans,trans) - htpSetProperty(page,'wheret,wheret) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f01qdfGen htPage == - n := htpProperty(htPage,'n) - m := htpProperty(htPage,'m) --- lda := htpProperty(htPage,'lda) --- ldb := htpProperty(htPage,'ldb) - lda := m - ldb := m - ncolb := htpProperty(htPage,'ncolb) - trans := htpProperty(htPage,'trans) - wheret := htpProperty(htPage,'wheret) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - for i in 1..n repeat - left := STRCONC((first y).1," ") - y := rest y - zetalist := [left,:zetalist] - zetastring := bcwords2liststring zetalist - y := REVERSE y - for i in 1..lda repeat - for j in 1..n repeat - elm := STRCONC((first y).1," ") - rowList := [:rowList,elm] - y := rest y - matform := [:matform,rowList] - rowList := [] - matstring := bcwords2liststring [bcwords2liststring x for x in matform] - for i in 1..ldb repeat - for j in 1..ncolb repeat - elm := STRCONC((first y).1," ") - rowList := [:rowList,elm] - y := rest y - bform := [:bform,rowList] - rowList := [] - bstring := bcwords2liststring [bcwords2liststring x for x in bform] - prefix := STRCONC('"f01qdf(_"",trans,"_",_"",wheret,"_",",STRINGIMAGE m,", ") - prefix := STRCONC(prefix,STRINGIMAGE n,", ",matstring,", ",STRINGIMAGE lda) - prefix := STRCONC(prefix,",[",zetastring,"],",STRINGIMAGE ncolb,", ") - prefix := STRCONC(prefix,STRINGIMAGE ldb,", ",bstring,", ",STRINGIMAGE ifail,")") - linkGen prefix - - -f01qef() == - htInitPage('"F01QEF - Operations with orthogonal matrices, form columns of {\it Q} after factorization by F01QCF or F01QFF",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXf01qef} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f01qef| '|NagMatrixOperationsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "Returns the first {\it ncolq} columns of the real {\it m} by ") - (text . "{\it n} orthogonal matrix {\it Q}, where {\it Q} is assumed ") - (text . "to be given by {\it Q = }\htbitmap{f01qdf1}, ") - (text . "\htbitmap{f01qdf2} being given in the form ") - (text . "\htbitmap{f01qcf1}, ") - (text . "where \htbitmap{f01qcf2}, ") - (text . "\htbitmap{f01qcf3}, ") - (text . "\htbitmap{zetak} is a scalar and ") - (text . "\htbitmap{zk} is an (m-k) element vector. ") - (text . "The routine is intended for use following F01QCF or F01QFF. ") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline Rows of matrix A, {\it m}: ") - (text . "\tab{32} \menuitemstyle{} \tab{34} ") - (text . "Columns of matrix A, {\it n}: \newline \tab{2} ") - (bcStrings (6 5 m PI)) - (text . "\tab{34} ") - (bcStrings (6 3 n PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") --- (text . "\newline First dimension of A, {\it lda} ") --- (text . "\htbitmap{great=} m: ") --- (text . "\tab{32} \menuitemstyle{} \tab{34} ") - (text . "Number columns of matrix Q {\it ncolq}: ") - (text . "\newline \tab{2} ") --- (bcStrings (6 5 lda PI)) --- (text . "\tab{34} ") - (bcStrings (6 5 ncolq PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Where the elements can be found: ") - (radioButtons wheret - (" " " the elements of \zeta are in ZETA, returned by F01QCF/F01QFF" subsequent) - (" " " the elements of \zeta are in A" initial)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'f01qefSolve) - htShowPage() - -f01qefSolve htPage == - m := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) - objValUnwrap htpLabelSpadValue(htPage, 'm) - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - lda := m --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lda) --- objValUnwrap htpLabelSpadValue(htPage, 'lda) - ncolq := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ncolq) - objValUnwrap htpLabelSpadValue(htPage, 'ncolq) - elements := htpButtonValue(htPage,'wheret) - wheret := - elements = 'initial => '"i" - '"s" - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - ((m = '5 and n = '3) and ncolq = '5) => f01qefDefaultSolve(htPage,lda,wheret,ifail) - matList := - "append"/[fa(i,ncolq) for i in 1..lda] where fa(i,ncolq) == - labelList := - "append"/[ga(i,j) for j in 1..ncolq] where ga(i,j) == - anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) - [['bcStrings,[7, "0.0", anam, 'F]]] - prefix := ('"\newline ") - labelList := [['text,:prefix],:labelList] - zList := - "append"/[fz(i) for i in 1..n] where fz(i) == - znam := INTERN STRCONC ('"z",STRINGIMAGE i) - [['bcStrings,[7, "0.0", znam, 'F]]] - prefix := ("\blankline \menuitemstyle{}\tab{2} Enter values of \zeta ") - prefix := STRCONC(prefix,"(if required): \newline ") - zList := [['text,:prefix],:zList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :matList,:zList] - page := htInitPage('"F01QEF - Operations with orthogonal matrices, form columns of {\it Q} after factorization by F01QCF or F01QFF",nil) - htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it Q}: " - htSay '"\newline " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'f01qefGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) --- htpSetProperty(page,'lda,lda) - htpSetProperty(page,'ncolq,ncolq) - htpSetProperty(page,'wheret,wheret) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -f01qefDefaultSolve (htPage,lda,wheret,ifail) == - n := '3 - m := '5 - ncolq := '5 - page := htInitPage('"F01QEF - Operations with orthogonal matrices, form columns of {\it Q} after factorization by F01QCF or F01QFF",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter values of {\it Q}") - (text . "(in this case returned by the default entries of F01QCF) : ") - (text . "\newline ") - (bcStrings (7 "-4.0" a11 F)) - (bcStrings (7 "-2.0" a12 F)) - (bcStrings (7 "-3.0" a13 F)) - (bcStrings (7 "0.0" a14 F)) - (bcStrings (7 "0.0" a15 F)) - (text . "\newline ") - (bcStrings (7 "0.4085" a21 F)) - (bcStrings (7 "-3.0" a22 F)) - (bcStrings (7 "-2.0" a23 F)) - (bcStrings (7 "0.0" a24 F)) - (bcStrings (7 "0.0" a25 F)) - (text . "\newline ") - (bcStrings (7 "0.3266" a31 F)) - (bcStrings (7 "-0.4619" a32 F)) - (bcStrings (7 "-4.0" a33 F)) - (bcStrings (7 "0.0" a34 F)) - (bcStrings (7 "0.0" a35 F)) - (text . "\newline ") - (bcStrings (7 "0.4082" a41 F)) - (bcStrings (7 "-0.5774" a42 F)) - (bcStrings (7 "0.0" a43 F)) - (bcStrings (7 "0.0" a44 F)) - (bcStrings (7 "0.0" a45 F)) - (text . "\newline ") - (bcStrings (7 "0.2449" a51 F)) - (bcStrings (7 "-0.3464" a52 F)) - (bcStrings (7 "-0.6326" a53 F)) - (bcStrings (7 "0.0" a54 F)) - (bcStrings (7 "0.0" a55 F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter values of \zeta: ") - (text . "\newline ") - (bcStrings (10 "1.2247" z1 F)) - (bcStrings (10 "1.1547" z2 F)) - (bcStrings (10 "1.2649" z3 F)) - (text . "\blankline ")) - htMakeDoneButton('"Continue",'f01qefGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) --- htpSetProperty(page,'lda,lda) - htpSetProperty(page,'ncolq,ncolq) - htpSetProperty(page,'wheret,wheret) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f01qefGen htPage == - n := htpProperty(htPage,'n) - m := htpProperty(htPage,'m) --- lda := htpProperty(htPage,'lda) - lda := m - ncolq := htpProperty(htPage,'ncolq) - wheret := htpProperty(htPage,'wheret) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - for i in 1..n repeat - left := STRCONC((first y).1," ") - y := rest y - zetalist := [left,:zetalist] - zetastring := bcwords2liststring zetalist - y := REVERSE y - for i in 1..lda repeat - for j in 1..ncolq repeat - elm := STRCONC((first y).1," ") - rowList := [:rowList,elm] - y := rest y - matform := [:matform,rowList] - rowList := [] - matstring := bcwords2liststring [bcwords2liststring x for x in matform] - prefix := STRCONC('"f01qef(_"",wheret,"_",",STRINGIMAGE m,", ") - prefix := STRCONC(prefix,STRINGIMAGE n,", ",STRINGIMAGE lda,", ") - prefix := STRCONC(prefix,STRINGIMAGE ncolq,",[",zetastring,"],") - prefix := STRCONC(prefix,matstring,", ",STRINGIMAGE ifail,")") - linkGen prefix - -f01rcf() == - htInitPage('"F01RCF - {\it QR} factorization of complex {\it m} by {\it n} matrix (m \htbitmap{great=} n)",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXf01rcf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f01rcf| '|NagMatrixOperationsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "Finds the QR factorization of the complex m by n matrix {\it A},") - (text . " which is factorized as \htbitmap{f01qcf}, where m > n") - (text . " and A = QR when m = n , where Q is an m by m unitary matrix ") - (text . "and R is an n by n upper triangular matrix with real diagonal ") - (text . "elements. The {\it k}th transformation matrix,{\it Qk}, ") - (text . "which is used to introduce zeros into the {\it k}th column of ") - (text . "{\it A}, is given in the form ") - (text . "\htbitmap{f01qcf1}, ") - (text . "where \htbitmap{f01rdf2}, ") - (text . "\htbitmap{f01qcf3}, ") - (text . "\htbitmap{gammak} is a scalar for which Re ") - (text . "\htbitmap{gammak} = 1.0, \htbitmap{zetak} ") - (text . "is a real scalar and \htbitmap{zk} is an ") - (text . "(m-k) element vector. ") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline Rows of matrix A, {\it m}: ") - (text . "\tab{32} \menuitemstyle{} \tab{34} ") - (text . "Columns of matrix A, {\it n}: \newline \tab{2} ") - (bcStrings (6 5 m PI)) - (text . "\tab{34} ") - (bcStrings (6 3 n PI)) --- (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{} \tab{2} ") --- (text . "\newline First dimension of A, {\it lda} ") --- (text . "\htbitmap{great=} m: ") --- (text . "\newline \tab{2} ") --- (bcStrings (6 5 lda PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'f01rcfSolve) - htShowPage() - -f01rcfSolve htPage == - m := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) - objValUnwrap htpLabelSpadValue(htPage, 'm) - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - lda := m --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lda) --- objValUnwrap htpLabelSpadValue(htPage, 'lda) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - (m = '5 and n = '3) => f01rcfDefaultSolve(htPage,ifail) - matList := - "append"/[fa(i,n) for i in 1..lda] where fa(i,n) == - labelList := - "append"/[ga(i,j) for j in 1..n] where ga(i,j) == - anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) - [['bcStrings,[16, "0.0 + 0.0*%i", anam, 'F]]] - prefix := ('"\newline \tab{2} ") - labelList := [['text,:prefix],:labelList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :matList] - page := htInitPage('"F01RCF - {\it QR} factorization of complex {\it m} by {\it n} matrix (m \htbitmap{great=} n)",nil) - htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " - htSay '"\newline \tab{2} " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'f01rcfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) --- htpSetProperty(page,'lda,lda) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -f01rcfDefaultSolve (htPage,ifail) == - n := '3 - m := '5 - lda := '5 - page := htInitPage('"F01RCF - {\it QR} factorization of complex {\it m} by {\it n} matrix (m \htbitmap{great=} n)",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ") - (text . "\newline \tab{2} ") - (bcStrings (15 "0.5*%i" a11 F)) - (bcStrings (15 "-0.5 + 1.5*%i" a12 F)) - (bcStrings (15 "-1.0 + 1.0*%i" a13 F)) - (text . "\newline \tab{2} ") - (bcStrings (15 "0.4 + 0.3*%i" a21 F)) - (bcStrings (15 "0.9 + 1.3*%i" a22 F)) - (bcStrings (15 "0.2 + 1.4*%i" a23 F)) - (text . "\newline \tab{2} ") - (bcStrings (15 "0.4" a31 F)) - (bcStrings (15 "-0.4 + 0.4*%i" a32 F)) - (bcStrings (15 "1.8" a33 F)) - (text . "\newline \tab{2} ") - (bcStrings (15 "0.3 - 0.4*%i" a41 F)) - (bcStrings (15 "0.1 + 0.7*%i" a42 F)) - (bcStrings (15 "0.0" a43 F)) - (text . "\newline \tab{2} ") - (bcStrings (15 "-0.3*%i" a51 F)) - (bcStrings (15 "0.3 + 0.3*%i" a52 F)) - (bcStrings (15 "2.4*%i" a53 F)) - (text . "\blankline ")) - htMakeDoneButton('"Continue",'f01rcfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) --- htpSetProperty(page,'lda,lda) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f01rcfGen htPage == - n := htpProperty(htPage,'n) - m := htpProperty(htPage,'m) --- lda := htpProperty(htPage,'lda) - lda := m - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - y := REVERSE y - for i in 1..lda repeat - for j in 1..n repeat - elm := STRCONC((first y).1," ") - rowList := [:rowList,elm] - y := rest y - matform := [:matform,rowList] - rowList := [] - matstring := bcwords2liststring [bcwords2liststring x for x in matform] - prefix := STRCONC('"f01rcf(",STRINGIMAGE m,", ",STRINGIMAGE n,", ") - prefix := STRCONC(prefix,STRINGIMAGE lda,", ",matstring) - linkGen STRCONC(prefix,", ",STRINGIMAGE ifail,")") - -f01rdf() == - htInitPage('"F01RDF - Operations with unitary matrices, compute {\it QB} or \htbitmap{f01rdf} after factorization by F01QCF",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXf01rdf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f01rdf| '|NagMatrixOperationsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "Performs one of the transformations B = QB or B = ") - (text . "\htbitmap{f01rdf}, where B is an m ") - (text . "by ncolb matrix and Q is an m by m ") - (text . "unitary matrix assumed to be given by Q = ") - (text . "\htbitmap{f01rdf1}, \htbitmap{f01qdf2} ") - (text . "being given in the form \htbitmap{f01qcf1}, ") - (text . "where \htbitmap{f01rdf2}, \htbitmap{f01qcf3}") - (text . ", \htbitmap{gammak} is a scalar for which Re ") - (text . "\htbitmap{gammak} = 1.0, \htbitmap{zetak} ") - (text . "is a real scalar and \htbitmap{zk} is an ") - (text . "(m-k) element vector. ") - (text . "The routine is intended for use following F01QCF or F01QFF. ") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline Rows of matrix A, {\it m}: ") - (text . "\tab{32} \menuitemstyle{} \tab{34} ") - (text . "Columns of matrix A, {\it n}: \newline \tab{2} ") - (bcStrings (6 5 m PI)) - (text . "\tab{34} ") - (bcStrings (6 3 n PI)) --- (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{} \tab{2} ") --- (text . "\newline First dimension of A, {\it lda} ") --- (text . "\htbitmap{great=} m: ") --- (text . "\tab{32} \menuitemstyle{} \tab{34} ") --- (text . "First dimension of B, {\it ldb} ") --- (text . "\htbitmap{great=} m: ") --- (text . "\newline \tab{2} ") --- (bcStrings (6 5 lda PI)) --- (text . "\tab{34} ") --- (bcStrings (6 5 ldb PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Number of columns of matrix B {\it ncolb}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 2 ncolb PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Transformation to be performed: ") - (radioButtons trans - (" " " {\it B = QB}" no_trans) - (" " " {\it B =} \htbitmap{f01rdf} (Conjugate Transpose)" trans)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Where the elements can be found: ") - (radioButtons wheret - (" " " the elements of \theta are in A" in_a) - (" " " the elements of \theta are in THETA" seperate)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'f01rdfSolve) - htShowPage() - -f01rdfSolve htPage == - m := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) - objValUnwrap htpLabelSpadValue(htPage, 'm) - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - lda := m --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lda) --- objValUnwrap htpLabelSpadValue(htPage, 'lda) - ldb := m --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ldb) --- objValUnwrap htpLabelSpadValue(htPage, 'ldb) - ncolb := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ncolb) - objValUnwrap htpLabelSpadValue(htPage, 'ncolb) - operation := htpButtonValue(htPage,'trans) - trans := - operation = 'no_trans => '"n" - '"c" - elements := htpButtonValue(htPage,'wheret) - wheret := - elements = 'in_a => '"i" - '"c" - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - ((m = '5 and n = '3) and ncolb = '2) => f01rdfDefaultSolve(htPage,lda,ldb,trans,wheret,ifail) - matList := - "append"/[fa(i,n) for i in 1..lda] where fa(i,n) == - labelList := - "append"/[ga(i,j) for j in 1..n] where ga(i,j) == - anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) - [['bcStrings,[16, "0.0 + 0.0*%i", anam, 'F]]] - prefix := ('"\newline \tab{2} ") - labelList := [['text,:prefix],:labelList] - bList := - "append"/[fb(i,ncolb) for i in 1..ldb] where fb(i,ncolb) == - labelList := - "append"/[gb(i,j) for j in 1..ncolb] where gb(i,j) == - bnam := INTERN STRCONC ('"b",STRINGIMAGE i, STRINGIMAGE j) - [['bcStrings,[16, "0.0 + 0.0*%i", bnam, 'F]]] - prefix := ('"\newline \tab{2} ") - labelList := [['text,:prefix],:labelList] - prefix := ("\blankline \menuitemstyle{}\tab{2} Enter values of {\it B}: ") - bList := [['text,:prefix],:bList] - zList := - "append"/[fz(i) for i in 1..n] where fz(i) == - znam := INTERN STRCONC ('"z",STRINGIMAGE i) - [['bcStrings,[16, "0.0", znam, 'F]]] - prefix := ("\blankline \menuitemstyle{}\tab{2} Enter values of \theta ") - prefix := STRCONC(prefix,"(if required): \newline \tab{2}") - zList := [['text,:prefix],:zList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :matList,:bList,:zList] - page := htInitPage('"F01RDF - Operations with orthogonal matrices, compute {\it QB} or \htbitmap{f01rdf} after factorization by F01QCF or F01RDF",nil) - htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " - htSay '"\newline \tab{2} " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'f01rdfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) --- htpSetProperty(page,'lda,lda) --- htpSetProperty(page,'ldb,ldb) - htpSetProperty(page,'ncolb,ncolb) - htpSetProperty(page,'trans,trans) - htpSetProperty(page,'wheret,wheret) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -f01rdfDefaultSolve (htPage,lda,ldb,trans,wheret,ifail) == - n := '3 - m := '5 - ncolb := '2 - page := htInitPage('"F01RDF - Operations with orthogonal matrices, compute {\it QB} or \htbitmap{f01rdf} after factorization by F01QCF or F01RDF",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ") - (text . "\newline \tab{2} ") - (bcStrings (15 "0.5*%i" a11 F)) - (bcStrings (15 "-0.5 + 1.5*%i" a12 F)) - (bcStrings (15 "-1.0 + 1.0*%i" a13 F)) - (text . "\newline \tab{2} ") - (bcStrings (15 "0.4 + 0.3*%i" a21 F)) - (bcStrings (15 "0.9 + 1.3*%i" a22 F)) - (bcStrings (15 "0.2 + 1.4*%i" a23 F)) - (text . "\newline \tab{2} ") - (bcStrings (15 "0.4" a31 F)) - (bcStrings (15 "-0.4 + 0.4*%i" a32 F)) - (bcStrings (15 "1.8" a33 F)) - (text . "\newline \tab{2} ") - (bcStrings (15 "0.3 - 0.4*%i" a41 F)) - (bcStrings (15 "0.1 + 0.7*%i" a42 F)) - (bcStrings (15 "0.0" a43 F)) - (text . "\newline \tab{2} ") - (bcStrings (15 "-0.3*%i" a51 F)) - (bcStrings (15 "0.3 + 0.3*%i" a52 F)) - (bcStrings (15 "2.4" a53 F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} Enter values of {\it B}: ") - (text . "\newline \tab{2} ") - (bcStrings (15 "-0.55 + 1.05*%i" b11 F)) - (bcStrings (15 "0.45 + 1.05*%i" b12 F)) - (text . "\newline \tab{2} ") - (bcStrings (15 "0.49 + 0.93*%i" b21 F)) - (bcStrings (15 "1.09 + 0.13*%i" b22 F)) - (text . "\newline \tab{2} ") - (bcStrings (15 "0.56 - 0.16*%i" b31 F)) - (bcStrings (15 "0.64 + 0.16*%i" b32 F)) - (text . "\newline \tab{2} ") - (bcStrings (15 "0.39 + 0.23*%i" b41 F)) - (bcStrings (15 "-0.39 - 0.23*%i" b42 F)) - (text . "\newline \tab{2} ") - (bcStrings (15 "1.13 + 0.83*%i" b51 F)) - (bcStrings (15 "-1.13 + 0.77*%i" b52 F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter values of \theta (if required): ") - (text . "\newline \tab{2} ") - (bcStrings (15 "0.0" z1 F)) - (bcStrings (15 "0.0" z2 F)) - (bcStrings (15 "0.0" z3 F)) - (text . "\blankline ")) - htMakeDoneButton('"Continue",'f01rdfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) --- htpSetProperty(page,'lda,lda) --- htpSetProperty(page,'ldb,ldb) - htpSetProperty(page,'ncolb,ncolb) - htpSetProperty(page,'trans,trans) - htpSetProperty(page,'wheret,wheret) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f01rdfGen htPage == - n := htpProperty(htPage,'n) - m := htpProperty(htPage,'m) --- lda := htpProperty(htPage,'lda) --- ldb := htpProperty(htPage,'ldb) - lda := m - ldb := m - ncolb := htpProperty(htPage,'ncolb) - trans := htpProperty(htPage,'trans) - wheret := htpProperty(htPage,'wheret) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - for i in 1..n repeat - left := STRCONC((first y).1," ") - y := rest y - zetalist := [left,:zetalist] - zetastring := bcwords2liststring zetalist - y := REVERSE y - for i in 1..lda repeat - for j in 1..n repeat - elm := STRCONC((first y).1," ") - rowList := [:rowList,elm] - y := rest y - matform := [:matform,rowList] - rowList := [] - matstring := bcwords2liststring [bcwords2liststring x for x in matform] - for i in 1..ldb repeat - for j in 1..ncolb repeat - elm := STRCONC((first y).1," ") - rowList := [:rowList,elm] - y := rest y - bform := [:bform,rowList] - rowList := [] - bstring := bcwords2liststring [bcwords2liststring x for x in bform] - prefix := STRCONC('"f01rdf(_"",trans,"_",_"",wheret,"_",",STRINGIMAGE m,", ") - prefix := STRCONC(prefix,STRINGIMAGE n,", ",matstring,", ",STRINGIMAGE lda) - prefix := STRCONC(prefix,",[",zetastring,"],",STRINGIMAGE ncolb,", ") - prefix := STRCONC(prefix,STRINGIMAGE ldb,", ",bstring,", ",STRINGIMAGE ifail,")") - linkGen prefix - - -f01ref() == - htInitPage('"F01REF - Operations with unitary matrices, form columns of {\it Q} after factorization by F01RCF",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXf01ref} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f01ref| '|NagMatrixOperationsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "Returns the first {\it ncolq} columns of the real {\it m} by ") - (text . "{\it m} unitary matrix {\it Q}, where {\it Q} is assumed ") - (text . "to be given by {\it Q = }\htbitmap{f01rdf1}, ") - (text . "\htbitmap{f01qdf2} being given in the form ") - (text . "\htbitmap{f01qcf1}, ") - (text . "where \htbitmap{f01rdf2}, ") - (text . "\htbitmap{f01qcf3}, ") - (text . "\htbitmap{gammak} is a scalar for which Re ") - (text . "\htbitmap{gammak} = 1.0, \htbitmap{zetak} ") - (text . "is a real scalar and \htbitmap{zk} is an ") - (text . "(m-k) element vector. ") - (text . "The routine is intended for use following F01RCF or F01RFF. ") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline Rows of matrix A, {\it m}: ") - (text . "\tab{32} \menuitemstyle{} \tab{34} ") - (text . "Columns of matrix A, {\it n}: \newline \tab{2} ") - (bcStrings (6 5 m PI)) - (text . "\tab{34} ") - (bcStrings (6 3 n PI)) --- (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{} \tab{2} ") --- (text . "\newline First dimension of A, {\it lda} ") --- (text . "\htbitmap{great=} m: ") --- (text . "\newline \tab{2} ") --- (bcStrings (6 5 lda PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Required number of columns of matrix Q {\it ncolq}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 2 ncolq PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Where the elements can be found: ") - (radioButtons wheret - (" " " the elements of \theta are in THETA" seperate) - (" " " the elements of \theta are in A" in_a)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'f01refSolve) - htShowPage() - -f01refSolve htPage == - m := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) - objValUnwrap htpLabelSpadValue(htPage, 'm) - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - lda := m --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lda) --- objValUnwrap htpLabelSpadValue(htPage, 'lda) - ncolq := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ncolq) - objValUnwrap htpLabelSpadValue(htPage, 'ncolq) - elements := htpButtonValue(htPage,'wheret) - wheret := - elements = 'in_a => '"i" - '"s" - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - ((m = '5 and n = '3) and ncolq = '2) => f01refDefaultSolve(htPage,lda,wheret,ifail) - matList := - "append"/[fa(i,n) for i in 1..lda] where fa(i,n) == - labelList := - "append"/[ga(i,j) for j in 1..n] where ga(i,j) == - anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) - [['bcStrings,[20, "0.0 + 0.0*%i", anam, 'F]]] - prefix := ('"\newline \tab{2} ") - labelList := [['text,:prefix],:labelList] - zList := - "append"/[fz(i) for i in 1..n] where fz(i) == - znam := INTERN STRCONC ('"z",STRINGIMAGE i) - [['bcStrings,[20, "0.0", znam, 'F]]] - prefix := ("\blankline \menuitemstyle{}\tab{2} Enter values of \theta ") - prefix := STRCONC(prefix,"(if required): \newline \tab{2}") - zList := [['text,:prefix],:zList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :matList,:zList] - page := htInitPage('"F01REF - Operations with unitary matrices, form columns of {\it Q} after factorization by F01RCF",nil) - htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " - htSay '"\newline \tab{2} " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'f01refGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) --- htpSetProperty(page,'lda,lda) - htpSetProperty(page,'ncolq,ncolq) - htpSetProperty(page,'wheret,wheret) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -f01refDefaultSolve (htPage,lda,wheret,ifail) == - n := '3 - m := '5 - ncolq := '2 - page := htInitPage('"F01REF - Operations with unitary matrices, form columns of {\it Q} after factorization by F01RCF",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ") - (text . "\newline \tab{2} ") - (bcStrings (16 "1" a11 F)) - (bcStrings (16 "1 + %i" a12 F)) - (bcStrings (16 "1 + %i" a13 F)) - (text . "\newline \tab{2} ") - (bcStrings (16 "-0.2-0.4*%i" a21 F)) - (bcStrings (16 "-2" a22 F)) - (bcStrings (16 "-1 - %i" a23 F)) - (text . "\newline \tab{2} ") - (bcStrings (16 "-0.32 - 0.16*%i" a31 F)) - (bcStrings (16 "-0.3505+0.263*%i" a32 F)) - (bcStrings (16 "-3" a33 F)) - (text . "\newline \tab{2} ") - (bcStrings (16 "-0.4 + 0.2*%i" a41 F)) - (bcStrings (16 "0.5477*%i" a42 F)) - (bcStrings (16 "0.0" a43 F)) - (text . "\newline \tab{2} ") - (bcStrings (16 "-0.12 + 0.24*%i" a51 F)) - (bcStrings (16 "0.1972+0.2629*%i" a52 F)) - (bcStrings (16 "0.6325" a53 F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter values of \theta: ") - (text . "\newline \tab{2} ") - (bcStrings (16 "1 + 0.5*%i" z1 F)) - (bcStrings (16 "1.0954-0.3333*%i" z2 F)) - (bcStrings (16 "1.2649-1.1565*%i" z3 F)) - (text . "\blankline ")) - htMakeDoneButton('"Continue",'f01refGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) --- htpSetProperty(page,'lda,lda) - htpSetProperty(page,'ncolq,ncolq) - htpSetProperty(page,'wheret,wheret) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f01refGen htPage == - n := htpProperty(htPage,'n) - m := htpProperty(htPage,'m) --- lda := htpProperty(htPage,'lda) - lda := m - ncolq := htpProperty(htPage,'ncolq) - wheret := htpProperty(htPage,'wheret) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - for i in 1..n repeat - left := STRCONC((first y).1," ") - y := rest y - thetalist := [left,:thetalist] - thetastring := bcwords2liststring thetalist - y := REVERSE y - for i in 1..lda repeat - for j in 1..n repeat - elm := STRCONC((first y).1," ") - rowList := [:rowList,elm] - y := rest y - matform := [:matform,rowList] - rowList := [] - matstring := bcwords2liststring [bcwords2liststring x for x in matform] - prefix := STRCONC('"f01ref(_"",wheret,"_",",STRINGIMAGE m,", ") - prefix := STRCONC(prefix,STRINGIMAGE n,", ",STRINGIMAGE ncolq,", ") - prefix := STRCONC(prefix,STRINGIMAGE lda,",[",thetastring,"],") - prefix := STRCONC(prefix,matstring,", ",STRINGIMAGE ifail,")") - linkGen prefix - -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/nag-f02.boot b/src/interp/nag-f02.boot new file mode 100644 index 00000000..f0cb92ed --- /dev/null +++ b/src/interp/nag-f02.boot @@ -0,0 +1,2735 @@ +-- 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. + + +)package "BOOT" + +f02aaf() == + htInitPage('"F02AAF - All eigenvalues of real symmetric matrix (Black box)",nil) + htMakePage '( + (domainConditions + (isDomain F (Float)) + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXf02aaf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02aaf| '|NagEigenPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\newline ") + (text . "Calculates all the eigenvalues of a real symmetric matrix ") + (text . "{\it A} of order {\it n}.") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline Order of matrix A, {\it n}: ") + (text . "\newline \tab{2} ") + (bcStrings (6 4 n PI)) +-- (text . "\blankline ") +-- (text . "\newline ") +-- (text . "\menuitemstyle{} \tab{2} ") +-- (text . "\newline First dimension of A, {\it ia} ") +-- (text . "\inputbitmap{\htbmdir{}/great=.bitmap} n: ") +-- (text . "\newline \tab{2} ") +-- (bcStrings (6 4 ia PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Ifail value: ") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'f02aafSolve) + htShowPage() + +f02aafSolve htPage == + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + ia := n +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ia) +-- objValUnwrap htpLabelSpadValue(htPage, 'ia) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + n = '4 => f02aafDefaultSolve(htPage,ia,ifail) + matList := + "append"/[f(i,n) for i in 1..ia] where f(i,n) == + labelList := + "append"/[g(i,j) for j in 1..n] where g(i,j) == + anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) + [['bcStrings,[6, "0.0", anam, 'F]]] + prefix := ('"\newline \tab{2} ") + labelList := [['text,:prefix],:labelList] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :matList] + page := htInitPage("F02AAF - All eigenvalues of real symmetric matrix (Black box)",nil) + htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " + htSay '"\newline \tab{2} " + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'f02aafGen) + htpSetProperty(page,'n,n) +-- htpSetProperty(page,'ia,ia) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +f02aafDefaultSolve (htPage,ia,ifail) == + n := '4 + page := htInitPage('"F02AAF - All eigenvalues of real symmetric matrix (Black box)",nil) + htMakePage '( + (domainConditions + (isDomain F (Float)) + (isDomain I (Integer))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ") + (text . "\newline \tab{2} ") + (bcStrings (6 "0.5" a11 F)) + (bcStrings (6 "0.0" a12 F)) + (bcStrings (6 "2.3" a13 F)) + (bcStrings (6 "-2.6" a14 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" a21 F)) + (bcStrings (6 "0.5" a22 F)) + (bcStrings (6 "-1.4" a23 F)) + (bcStrings (6 "-0.7" a24 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "2.3" a31 F)) + (bcStrings (6 "-1.4" a32 F)) + (bcStrings (6 "0.5" a33 F)) + (bcStrings (6 "0.0" a34 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "-2.6" a41 F)) + (bcStrings (6 "-0.7" a42 F)) + (bcStrings (6 "0.0" a43 F)) + (bcStrings (6 "0.5" a44 F))) + htMakeDoneButton('"Continue",'f02aafGen) + htpSetProperty(page,'n,n) +-- htpSetProperty(page,'ia,ia) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +f02aafGen htPage == + n := htpProperty(htPage,'n) + -- ia should be = n, unlike the example program + -- where ia = nmax +-- ia := htpProperty(htPage,'ia) + ia := n + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + y := REVERSE y + for i in 1..ia repeat + for j in 1..n repeat + elm := STRCONC((first y).1," ") + rowList := [:rowList,elm] + y := rest y + matform := [:matform,rowList] + rowList := [] + matstring := bcwords2liststring [bcwords2liststring x for x in matform] + prefix := STRCONC('"f02aaf(",STRINGIMAGE ia,", ",STRINGIMAGE n,", ") + prefix := STRCONC(prefix,matstring,", ",STRINGIMAGE ifail,")") + linkGen prefix + +f02abf() == + htInitPage('"F02ABF - All eigenvalues and eignevectors of real symmetric matrix (Black box)",nil) + htMakePage '( + (domainConditions + (isDomain F (Float)) + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXf02abf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02abf| '|NagEigenPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\newline ") + (text . "Calculates all the eigenvalues and eigenvectors of a real ") + (text . "symmetric matrix ") + (text . "{\it A} of order {\it n}.") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline Order of matrix A, {\it n}: ") + (text . "\newline \tab{2} ") + (bcStrings (6 4 n PI)) +-- (text . "\blankline ") +-- (text . "\newline ") +-- (text . "\menuitemstyle{} \tab{2} ") +-- (text . "\newline First dimension of A, {\it ia} ") +-- (text . "\inputbitmap{\htbmdir{}/great=.bitmap} n: ") +-- (text . "\tab{32} \menuitemstyle{} \tab{34} ") +-- (text . "First dimension of V, {\it v} ") +-- (text . "\inputbitmap{\htbmdir{}/great=.bitmap} n: ") +-- (text . "\newline \tab{2} ") +-- (bcStrings (6 4 ia PI)) +-- (text . "\tab{34} ") +-- (bcStrings (6 4 v PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Ifail value: ") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'f02abfSolve) + htShowPage() + +f02abfSolve htPage == + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + ia := n +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ia) +-- objValUnwrap htpLabelSpadValue(htPage, 'ia) + iv := n +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'v) +-- objValUnwrap htpLabelSpadValue(htPage, 'v) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + n = '4 => f02abfDefaultSolve(htPage,ia,iv,ifail) + matList := + "append"/[f(i,n) for i in 1..ia] where f(i,n) == + labelList := + "append"/[g(i,j) for j in 1..n] where g(i,j) == + anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) + [['bcStrings,[6, "0.0", anam, 'F]]] + prefix := ('"\newline \tab{2} ") + labelList := [['text,:prefix],:labelList] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :matList] + page := htInitPage("F02ABF - All eigenvalues and eigenvectors of real symmetric matrix (Black box)",nil) + htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " + htSay '"\newline \tab{2} " + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'f02abfGen) + htpSetProperty(page,'n,n) +-- htpSetProperty(page,'ia,ia) +-- htpSetProperty(page,'iv,iv) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +f02abfDefaultSolve (htPage,ia,iv,ifail) == + n := '4 + page := htInitPage('"F02ABF - All eigenvalues and eigenvectors of real symmetric matrix (Black box)",nil) + htMakePage '( + (domainConditions + (isDomain F (Float)) + (isDomain I (Integer))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ") + (text . "\newline \tab{2} ") + (bcStrings (6 "0.5" a11 F)) + (bcStrings (6 "0.0" a12 F)) + (bcStrings (6 "2.3" a13 F)) + (bcStrings (6 "-2.6" a14 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" a21 F)) + (bcStrings (6 "0.5" a22 F)) + (bcStrings (6 "-1.4" a23 F)) + (bcStrings (6 "-0.7" a24 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "2.3" a31 F)) + (bcStrings (6 "-1.4" a32 F)) + (bcStrings (6 "0.5" a33 F)) + (bcStrings (6 "0.0" a34 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "-2.6" a41 F)) + (bcStrings (6 "-0.7" a42 F)) + (bcStrings (6 "0.0" a43 F)) + (bcStrings (6 "0.5" a44 F))) + htMakeDoneButton('"Continue",'f02abfGen) + htpSetProperty(page,'n,n) +-- htpSetProperty(page,'ia,ia) +-- htpSetProperty(page,'iv,iv) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +f02abfGen htPage == + n := htpProperty(htPage,'n) + -- ia should be = n, unlike the example program + -- where ia = nmax +-- ia := htpProperty(htPage,'ia) +-- iv := htpProperty(htPage,'iv) + ia := n + iv := n + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + y := REVERSE y + for i in 1..ia repeat + for j in 1..n repeat + elm := STRCONC((first y).1," ") + rowList := [:rowList,elm] + y := rest y + matform := [:matform,rowList] + rowList := [] + matstring := bcwords2liststring [bcwords2liststring x for x in matform] + prefix := STRCONC('"f02abf(",matstring,", ",STRINGIMAGE ia,", ") + prefix := STRCONC(prefix,STRINGIMAGE n,", ",STRINGIMAGE iv,", ") + linkGen STRCONC(prefix,STRINGIMAGE ifail,")") + +f02adf() == + htInitPage('"F02ADF - All eigenvalues of generalized real eigenproblem of the form Ax = \lambda Bx where A and B are symmetric and B is positive definite",nil) + htMakePage '( + (domainConditions + (isDomain F (Float)) + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXf02adf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02adf| '|NagEigenPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\blankline ") + (text . "Calculates all the eigenvalues of Ax = \lambda Bx, where ") + (text . "A and B are real symmetric matrices of order n and B is positive-definite ") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline Order of matrices A and B, {\it n}: ") + (text . "\newline \tab{2} ") + (bcStrings (6 4 n PI)) +-- (text . "\blankline ") +-- (text . "\newline ") +-- (text . "\menuitemstyle{} \tab{2} ") +-- (text . "\newline First dimension of A, {\it ia}: ") +-- (text . "\tab{32} \menuitemstyle{} \tab{34} ") +-- (text . "\newline First dimension of B, {\it ib}: ") +-- (text . "\newline \tab{2} ") +-- (bcStrings (6 4 ia PI)) +-- (text . "\tab{34} ") +-- (bcStrings (6 4 ib F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Ifail value: ") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'f02adfSolve) + htShowPage() + +f02adfSolve htPage == + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + ia := n +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ia) +-- objValUnwrap htpLabelSpadValue(htPage, 'ia) + ib := n +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ib) +-- objValUnwrap htpLabelSpadValue(htPage, 'ib) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + n = '4 => f02adfDefaultSolve(htPage,ia,ib,ifail) + matList := + "append"/[f(i,n) for i in 1..ia] where f(i,n) == + labelList := + "append"/[g(i,j) for j in 1..n] where g(i,j) == + anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) + [['bcStrings,[6, "0.0", anam, 'F]]] + prefix := ('"\newline \tab{2} ") + labelList := [['text,:prefix],:labelList] + bmatList := + "append"/[h(k,n) for k in 1..ib] where h(k,n) == + bList := + "append"/[l(k,p) for p in 1..n] where l(k,p) == + bnam := INTERN STRCONC ('"b",STRINGIMAGE k,STRINGIMAGE p) + [['bcStrings,[6, "0.0", bnam, 'F]]] + prefix := ('"\newline \tab{2} ") + bList := [['text,:prefix],:bList] + start := ('"\blankline \menuitemstyle{} \tab{2} Enter values of {\it b}:") + bmatList := [['text,:start],:bmatList] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :matList,:bmatList] + page := htInitPage("F02ADF - All eigenvalues of generalized real eigenproblem of the form Ax = \lambda Bx where A and B are symmetric and B is positive definite",nil) + htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " + htSay '"\newline \tab{2} " + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'f02adfGen) + htpSetProperty(page,'n,n) +-- htpSetProperty(page,'ia,ia) +-- htpSetProperty(page,'ib,ib) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +f02adfDefaultSolve (htPage,ia,ib,ifail) == + n := '4 + page := htInitPage('"F02ADF - All eigenvalues of generalized real eigenproblem of the form Ax = \lambda Bx where A and B are symmetric and B is positive definite",nil) + htMakePage '( + (domainConditions + (isDomain F (Float)) + (isDomain I (Integer))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ") + (text . "\newline \tab{2} ") + (bcStrings (6 "0.5" a11 F)) + (bcStrings (6 "1.5" a12 F)) + (bcStrings (6 "6.6" a13 F)) + (bcStrings (6 "4.8" a14 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "1.5" a21 F)) + (bcStrings (6 "6.5" a22 F)) + (bcStrings (6 "16.2" a23 F)) + (bcStrings (6 "8.6" a24 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "6.6" a31 F)) + (bcStrings (6 "16.2" a32 F)) + (bcStrings (6 "37.6" a33 F)) + (bcStrings (6 "9.8" a34 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "4.8" a41 F)) + (bcStrings (6 "8.6" a42 F)) + (bcStrings (6 "9.8" a43 F)) + (bcStrings (6 "-17.1" a44 F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Enter values of {\it B}: ") + (text . "\newline \tab{2} ") + (bcStrings (6 1 b11 F)) + (bcStrings (6 3 b12 F)) + (bcStrings (6 4 b13 F)) + (bcStrings (6 1 b14 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 3 b21 F)) + (bcStrings (6 13 b22 F)) + (bcStrings (6 16 b23 F)) + (bcStrings (6 11 b24 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 4 b31 F)) + (bcStrings (6 16 b32 F)) + (bcStrings (6 24 b33 F)) + (bcStrings (6 18 b34 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 1 b41 F)) + (bcStrings (6 11 b42 F)) + (bcStrings (6 18 b43 F)) + (bcStrings (6 27 b44 F))) + htMakeDoneButton('"Continue",'f02adfGen) + htpSetProperty(page,'n,n) +-- htpSetProperty(page,'ia,ia) +-- htpSetProperty(page,'ib,ib) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +f02adfGen htPage == + n := htpProperty(htPage,'n) +-- ia := htpProperty(htPage,'ia) +-- ib := htpProperty(htPage,'ib) + ia := n + ib := n + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + y := REVERSE y + for i in 1..ia repeat + for j in 1..n repeat + elm := STRCONC((first y).1," ") + rowList := [:rowList,elm] + y := rest y + matform := [:matform,rowList] + rowList := [] + for i in 1..ib repeat + for j in 1..n repeat + elm := STRCONC((first y).1," ") + rowList := [:rowList,elm] + y := rest y + bform := [:bform,rowList] + rowList := [] + matstring := bcwords2liststring [bcwords2liststring x for x in matform] + bstring := bcwords2liststring [bcwords2liststring x for x in bform] + prefix := STRCONC('"f02adf(",STRINGIMAGE ia,", ",STRINGIMAGE ib,", ") + prefix := STRCONC(prefix,STRINGIMAGE n,", ",matstring,", ",bstring,", ") + prefix := STRCONC(prefix,STRINGIMAGE ifail,")") + linkGen prefix + +f02aef() == + htInitPage('"F02AEF - All eigenvalues and eigenvectors of generalized real eigenproblem of the form Ax = \lambda Bx where A and B are symmetric and B is positive definite",nil) + htMakePage '( + (domainConditions + (isDomain F (Float)) + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXf02aef} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02aef| '|NagEigenPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\blankline ") + (text . "Calculates all the eigenvalues and eigenvectors of Ax = ") + (text . "\lambda Bx, where A and B are real symmetric matrices of order ") + (text . "n and B is positive-definite ") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline Order of matrices A and B, {\it n}: ") + (text . "\newline \tab{2} ") + (bcStrings (6 4 n PI)) +-- (text . "\blankline ") +-- (text . "\newline ") +-- (text . "\menuitemstyle{} \tab{2} ") +-- (text . "\newline First dimension of A, {\it ia}: ") +-- (text . "\tab{32} \menuitemstyle{} \tab{34} ") +-- (text . "\newline First dimension of B, {\it ib}: ") +-- (text . "\newline \tab{2} ") +-- (bcStrings (6 4 ia PI)) +-- (text . "\tab{34} ") +-- (bcStrings (6 4 ib F)) +-- (text . "\blankline ") +-- (text . "\newline ") +-- (text . "\menuitemstyle{} \tab{2} ") +-- (text . "\newline First dimension of V, {\it iv}: ") +-- (text . "\newline \tab{2} ") +-- (bcStrings (6 4 iv PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Ifail value: ") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'f02aefSolve) + htShowPage() + +f02aefSolve htPage == + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + ia := n +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ia) +-- objValUnwrap htpLabelSpadValue(htPage, 'ia) + ib := n +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ib) +-- objValUnwrap htpLabelSpadValue(htPage, 'ib) + iv := n +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iv) +-- objValUnwrap htpLabelSpadValue(htPage, 'iv) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + n = '4 => f02aefDefaultSolve(htPage,ia,ib,iv,ifail) + matList := + "append"/[f(i,n) for i in 1..ia] where f(i,n) == + labelList := + "append"/[g(i,j) for j in 1..n] where g(i,j) == + anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) + [['bcStrings,[6, "0.0", anam, 'F]]] + prefix := ('"\newline \tab{2} ") + labelList := [['text,:prefix],:labelList] + bmatList := + "append"/[h(k,n) for k in 1..ib] where h(k,n) == + bList := + "append"/[l(k,p) for p in 1..n] where l(k,p) == + bnam := INTERN STRCONC ('"b",STRINGIMAGE k,STRINGIMAGE p) + [['bcStrings,[6, "0.0", bnam, 'F]]] + prefix := ('"\newline \tab{2} ") + bList := [['text,:prefix],:bList] + start := ('"\blankline \menuitemstyle{} \tab{2} Enter values of {\it b}:") + bmatList := [['text,:start],:bmatList] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :matList,:bmatList] + page := htInitPage("F02AEF - All eigenvalues and eigenvectors of generalized real eigenproblem of the form Ax = \lambda Bx where A and B are symmetric and B is positive definite",nil) + htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " + htSay '"\newline \tab{2} " + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'f02aefGen) + htpSetProperty(page,'n,n) +-- htpSetProperty(page,'ia,ia) +-- htpSetProperty(page,'ib,ib) +-- htpSetProperty(page,'iv,iv) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +f02aefDefaultSolve (htPage,ia,ib,iv,ifail) == + n := '4 + page := htInitPage('"F02AEF - All eigenvalues and eigenvectors of generalized real eigenproblem of the form Ax = \lambda Bx where A and B are symmetric and B is positive definite",nil) + htMakePage '( + (domainConditions + (isDomain F (Float)) + (isDomain I (Integer))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ") + (text . "\newline \tab{2} ") + (bcStrings (6 "0.5" a11 F)) + (bcStrings (6 "1.5" a12 F)) + (bcStrings (6 "6.6" a13 F)) + (bcStrings (6 "4.8" a14 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "1.5" a21 F)) + (bcStrings (6 "6.5" a22 F)) + (bcStrings (6 "16.2" a23 F)) + (bcStrings (6 "8.6" a24 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "6.6" a31 F)) + (bcStrings (6 "16.2" a32 F)) + (bcStrings (6 "37.6" a33 F)) + (bcStrings (6 "9.8" a34 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "4.8" a41 F)) + (bcStrings (6 "8.6" a42 F)) + (bcStrings (6 "9.8" a43 F)) + (bcStrings (6 "-17.1" a44 F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Enter values of {\it B}: ") + (text . "\newline \tab{2} ") + (bcStrings (6 1 b11 F)) + (bcStrings (6 3 b12 F)) + (bcStrings (6 4 b13 F)) + (bcStrings (6 1 b14 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 3 b21 F)) + (bcStrings (6 13 b22 F)) + (bcStrings (6 16 b23 F)) + (bcStrings (6 11 b24 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 4 b31 F)) + (bcStrings (6 16 b32 F)) + (bcStrings (6 24 b33 F)) + (bcStrings (6 18 b34 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 1 b41 F)) + (bcStrings (6 11 b42 F)) + (bcStrings (6 18 b43 F)) + (bcStrings (6 27 b44 F))) + htMakeDoneButton('"Continue",'f02aefGen) + htpSetProperty(page,'n,n) +-- htpSetProperty(page,'ia,ia) +-- htpSetProperty(page,'ib,ib) +-- htpSetProperty(page,'iv,iv) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +f02aefGen htPage == + n := htpProperty(htPage,'n) +-- ia := htpProperty(htPage,'ia) +-- ib := htpProperty(htPage,'ib) +-- iv := htpProperty(htPage,'iv) + ia := n + ib := n + iv := n + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + y := REVERSE y + for i in 1..ia repeat + for j in 1..n repeat + elm := STRCONC((first y).1," ") + rowList := [:rowList,elm] + y := rest y + matform := [:matform,rowList] + rowList := [] + for i in 1..ib repeat + for j in 1..n repeat + elm := STRCONC((first y).1," ") + rowList := [:rowList,elm] + y := rest y + bform := [:bform,rowList] + rowList := [] + matstring := bcwords2liststring [bcwords2liststring x for x in matform] + bstring := bcwords2liststring [bcwords2liststring x for x in bform] + prefix := STRCONC('"f02aef(",STRINGIMAGE ia,", ",STRINGIMAGE ib,", ") + prefix := STRCONC(prefix,STRINGIMAGE n,", ",STRINGIMAGE iv,", ") + prefix := STRCONC(prefix,matstring,", ",bstring,", ") + prefix := STRCONC(prefix,STRINGIMAGE ifail,")") + linkGen prefix + + +f02aff() == + htInitPage('"F02AFF - All eigenvalues of real matrix (Black box)",nil) + htMakePage '( + (domainConditions + (isDomain F (Float)) + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXf02aff} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02aff| '|NagEigenPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\newline ") + (text . "Calculates all the eigenvalues of a real unsymmetric matrix ") + (text . "{\it A} of order {\it n}.") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline Order of matrix A, {\it n}: ") + (text . "\newline \tab{2} ") + (bcStrings (6 4 n PI)) +-- (text . "\blankline ") +-- (text . "\newline ") +-- (text . "\menuitemstyle{} \tab{2} ") +-- (text . "\newline First dimension of A, {\it ia} ") +-- (text . "\inputbitmap{\htbmdir{}/great=.bitmap} n: ") +-- (text . "\newline \tab{2} ") +-- (bcStrings (6 4 ia PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Ifail value: ") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'f02affSolve) + htShowPage() + +f02affSolve htPage == + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + ia := n +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ia) +-- objValUnwrap htpLabelSpadValue(htPage, 'ia) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + n = '4 => f02affDefaultSolve(htPage,ia,ifail) + matList := + "append"/[f(i,n) for i in 1..ia] where f(i,n) == + labelList := + "append"/[g(i,j) for j in 1..n] where g(i,j) == + anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) + [['bcStrings,[6, "0.0", anam, 'F]]] + prefix := ('"\newline \tab{2} ") + labelList := [['text,:prefix],:labelList] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :matList] + page := htInitPage("F02AFF - All eigenvalues of real matrix (Black box)",nil) + htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " + htSay '"\newline \tab{2} " + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'f02affGen) + htpSetProperty(page,'n,n) +-- htpSetProperty(page,'ia,ia) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +f02affDefaultSolve (htPage,ia,ifail) == + n := '4 + page := htInitPage('"F02AFF - All eigenvalues of real matrix (Black box)",nil) + htMakePage '( + (domainConditions + (isDomain F (Float)) + (isDomain I (Integer))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ") + (text . "\newline \tab{2} ") + (bcStrings (6 "1.5" a11 F)) + (bcStrings (6 "0.1" a12 F)) + (bcStrings (6 "4.5" a13 F)) + (bcStrings (6 "-1.5" a14 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "-22.5" a21 F)) + (bcStrings (6 "3.5" a22 F)) + (bcStrings (6 "12.5" a23 F)) + (bcStrings (6 "-2.5" a24 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "-2.5" a31 F)) + (bcStrings (6 "0.3" a32 F)) + (bcStrings (6 "4.5" a33 F)) + (bcStrings (6 "-2.5" a34 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "-2.5" a41 F)) + (bcStrings (6 "0.1" a42 F)) + (bcStrings (6 "4.5" a43 F)) + (bcStrings (6 "2.5" a44 F))) + htMakeDoneButton('"Continue",'f02affGen) + htpSetProperty(page,'n,n) +-- htpSetProperty(page,'ia,ia) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +f02affGen htPage == + n := htpProperty(htPage,'n) + -- ia should be = n, unlike the example program + -- where ia = nmax +-- ia := htpProperty(htPage,'ia) + ia := n + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + y := REVERSE y + for i in 1..ia repeat + for j in 1..n repeat + elm := STRCONC((first y).1," ") + rowList := [:rowList,elm] + y := rest y + matform := [:matform,rowList] + rowList := [] + matstring := bcwords2liststring [bcwords2liststring x for x in matform] + prefix := STRCONC('"f02aff(",STRINGIMAGE ia,", ",STRINGIMAGE n,", ") + prefix := STRCONC(prefix,matstring,", ",STRINGIMAGE ifail,")") + linkGen prefix + +f02agf() == + htInitPage('"F02AGF - All eigenvalues and eignevectors of real matrix (Black box)",nil) + htMakePage '( + (domainConditions + (isDomain F (Float)) + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXf02agf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02agf| '|NagEigenPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\newline ") + (text . "Calculates all the eigenvalues and eigenvectors of a real ") + (text . "unsymmetric matrix {\it A} of order {\it n}.") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline Order of matrix A, {\it n}: ") + (text . "\newline \tab{2} ") + (bcStrings (6 4 n PI)) +-- (text . "\blankline ") +-- (text . "\newline ") +-- (text . "\menuitemstyle{} \tab{2} ") +-- (text . "\newline First dimension of A, {\it ia} ") +-- (text . "\inputbitmap{\htbmdir{}/great=.bitmap} n: ") +-- (text . "\tab{32} \menuitemstyle{} \tab{34} ") +-- (text . "First dimension of VR, {\it ivr} ") +-- (text . "\inputbitmap{\htbmdir{}/great=.bitmap} n: ") +-- (text . "\newline \tab{2} ") +-- (bcStrings (6 4 ia PI)) +-- (text . "\tab{34} ") +-- (bcStrings (6 4 ivr PI)) +-- (text . "\blankline ") +-- (text . "\newline ") +-- (text . "\menuitemstyle{} \tab{2} ") +-- (text . "\newline First dimension of VI, {\it ivi} ") +-- (text . "\inputbitmap{\htbmdir{}/great=.bitmap} n: ") +-- (text . "\newline \tab{2} ") +-- (bcStrings (6 4 ivi PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Ifail value: ") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'f02agfSolve) + htShowPage() + +f02agfSolve htPage == + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + ia := n +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ia) +-- objValUnwrap htpLabelSpadValue(htPage, 'ia) + ivr := n +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ivr) +-- objValUnwrap htpLabelSpadValue(htPage, 'ivr) + ivi := n +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ivi) +-- objValUnwrap htpLabelSpadValue(htPage, 'ivi) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + n = '4 => f02agfDefaultSolve(htPage,ia,ivr,ivi,ifail) + matList := + "append"/[f(i,n) for i in 1..ia] where f(i,n) == + labelList := + "append"/[g(i,j) for j in 1..n] where g(i,j) == + anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) + [['bcStrings,[6, "0.0", anam, 'F]]] + prefix := ('"\newline \tab{2} ") + labelList := [['text,:prefix],:labelList] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :matList] + page := htInitPage("F02AGF - All eigenvalues and eigenvectors of real matrix (Black box)",nil) + htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " + htSay '"\newline \tab{2} " + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'f02agfGen) + htpSetProperty(page,'n,n) +-- htpSetProperty(page,'ia,ia) +-- htpSetProperty(page,'ivr,ivr) +-- htpSetProperty(page,'ivi,ivi) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +f02agfDefaultSolve (htPage,ia,ivr,ivi,ifail) == + n := '4 + page := htInitPage('"F02AGF - All eigenvalues and eigenvectors of real matrix (Black box)",nil) + htMakePage '( + (domainConditions + (isDomain F (Float)) + (isDomain I (Integer))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ") + (text . "\newline \tab{2} ") + (bcStrings (6 "1.5" a11 F)) + (bcStrings (6 "0.1" a12 F)) + (bcStrings (6 "4.5" a13 F)) + (bcStrings (6 "-1.5" a14 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "-22.5" a21 F)) + (bcStrings (6 "3.5" a22 F)) + (bcStrings (6 "12.5" a23 F)) + (bcStrings (6 "-2.5" a24 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "-2.5" a31 F)) + (bcStrings (6 "0.3" a32 F)) + (bcStrings (6 "4.5" a33 F)) + (bcStrings (6 "-2.5" a34 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "-2.5" a41 F)) + (bcStrings (6 "0.1" a42 F)) + (bcStrings (6 "4.5" a43 F)) + (bcStrings (6 "2.5" a44 F))) + htMakeDoneButton('"Continue",'f02agfGen) + htpSetProperty(page,'n,n) +-- htpSetProperty(page,'ia,ia) +-- htpSetProperty(page,'ivr,ivr) +-- htpSetProperty(page,'ivi,ivi) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +f02agfGen htPage == + n := htpProperty(htPage,'n) + -- ia should be = n, unlike the example program + -- where ia = nmax +-- ia := htpProperty(htPage,'ia) +-- ivr := htpProperty(htPage,'ivr) +-- ivi := htpProperty(htPage,'ivi) + ia := n + ivr := n + ivi := n + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + y := REVERSE y + for i in 1..ia repeat + for j in 1..n repeat + elm := STRCONC((first y).1," ") + rowList := [:rowList,elm] + y := rest y + matform := [:matform,rowList] + rowList := [] + matstring := bcwords2liststring [bcwords2liststring x for x in matform] + prefix := STRCONC('"f02agf(",STRINGIMAGE ia,", ",STRINGIMAGE n,", ") + prefix := STRCONC(prefix,STRINGIMAGE ivr,", ",STRINGIMAGE ivi,", ") + linkGen STRCONC(prefix,matstring,", ",STRINGIMAGE ifail,")") + +f02ajf() == + htInitPage('"F02AJF - All eigenvalues of complex matrix (Black box)",nil) + htMakePage '( + (domainConditions + (isDomain F (Float)) + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXf02ajf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02ajf| '|NagEigenPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\blankline ") + (text . "Calculates all the eigenvalues of a complex matrix {\it A} ") + (text . "of order {\it n}.") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline Order of matrix A, {\it n}: ") + (text . "\newline \tab{2} ") + (bcStrings (6 4 n PI)) +-- (text . "\blankline ") +-- (text . "\newline ") +-- (text . "\menuitemstyle{} \tab{2} ") +-- (text . "\newline First dimension of array containing real parts, ") +-- (text . " {\it iar}: \newline \tab{2} ") +-- (bcStrings (6 4 iar PI)) +-- (text . "\blankline ") +-- (text . "\newline ") +-- (text . "\menuitemstyle{} \tab{2} ") +-- (text . "\newline First dimension of array containing imaginary parts,") +-- (text . " {\it iai}: \newline \tab{2} ") +-- (bcStrings (6 4 iai F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Ifail value: ") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'f02ajfSolve) + htShowPage() + +f02ajfSolve htPage == + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + iar := n +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iar) +-- objValUnwrap htpLabelSpadValue(htPage, 'iar) + iai := n +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iai) +-- objValUnwrap htpLabelSpadValue(htPage, 'iai) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + n = '4 => f02ajfDefaultSolve(htPage,iar,iai,ifail) + matList := + "append"/[f(i,n) for i in 1..iar] where f(i,n) == + labelList := + "append"/[g(i,j) for j in 1..n] where g(i,j) == + anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) + [['bcStrings,[6, "0.0", anam, 'F]]] + prefix := ('"\newline \tab{2} ") + labelList := [['text,:prefix],:labelList] + bmatList := + "append"/[h(k,n) for k in 1..iai] where h(k,n) == + bList := + "append"/[l(k,p) for p in 1..n] where l(k,p) == + bnam := INTERN STRCONC ('"b",STRINGIMAGE k,STRINGIMAGE p) + [['bcStrings,[6, "0.0", bnam, 'F]]] + prefix := ('"\newline \tab{2} ") + bList := [['text,:prefix],:bList] + start := ('"\blankline \menuitemstyle{}\tab{2}Enter imag values of {\it A}:") + bmatList := [['text,:start],:bmatList] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :matList,:bmatList] + page := htInitPage("F02AJF - All eigenvalues of complex matrix (Black box)",nil) + htSay '"\newline \menuitemstyle{}\tab{2} Enter real values of {\it A}: " + htSay '"\newline \tab{2} " + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'f02ajfGen) + htpSetProperty(page,'n,n) +-- htpSetProperty(page,'iar,iar) +-- htpSetProperty(page,'iai,iai) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +f02ajfDefaultSolve (htPage,iar,iai,ifail) == + n := '4 + page := htInitPage('"F02AJF - All eigenvalues of complex matrix (Black box)",nil) + htMakePage '( + (domainConditions + (isDomain F (Float)) + (isDomain I (Integer))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Enter real values of {\it A}: ") + (text . "\newline \tab{2} ") + (bcStrings (6 "-21.0" a11 F)) + (bcStrings (6 "0.0" a12 F)) + (bcStrings (6 "13.6" a13 F)) + (bcStrings (6 "0.0" a14 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" a21 F)) + (bcStrings (6 "26.0" a22 F)) + (bcStrings (6 "7.5" a23 F)) + (bcStrings (6 "2.5" a24 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "-2.0" a31 F)) + (bcStrings (6 "1.68" a32 F)) + (bcStrings (6 "4.5" a33 F)) + (bcStrings (6 "1.5" a34 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" a41 F)) + (bcStrings (6 "-2.6" a42 F)) + (bcStrings (6 "-2.7" a43 F)) + (bcStrings (6 "2.5" a44 F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Enter imaginary values of {\it A}: ") + (text . "\newline \tab{2} ") + (bcStrings (6 "-5.0" b11 F)) + (bcStrings (6 "24.6" b12 F)) + (bcStrings (6 "10.2"b13 F)) + (bcStrings (6 "4.0" b14 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "22.5" b21 F)) + (bcStrings (6 "-5.0" b22 F)) + (bcStrings (6 "-10.0" b23 F)) + (bcStrings (6 "0.0" b24 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "1.5" b31 F)) + (bcStrings (6 "2.24" b32 F)) + (bcStrings (6 "-5.0" b33 F)) + (bcStrings (6 "2.0" b34 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "-2.5" b41 F)) + (bcStrings (6 "0.0" b42 F)) + (bcStrings (6 "3.6" b43 F)) + (bcStrings (6 "-5.0" b44 F))) + htMakeDoneButton('"Continue",'f02ajfGen) + htpSetProperty(page,'n,n) +-- htpSetProperty(page,'iar,iar) +-- htpSetProperty(page,'iai,iai) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +f02ajfGen htPage == + n := htpProperty(htPage,'n) +-- iar := htpProperty(htPage,'iar) +-- iai := htpProperty(htPage,'iai) + iar := n + iai := n + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + y := REVERSE y + for i in 1..iar repeat + for j in 1..n repeat + elm := STRCONC((first y).1," ") + rowList := [:rowList,elm] + y := rest y + matform := [:matform,rowList] + rowList := [] + for i in 1..iai repeat + for j in 1..n repeat + elm := STRCONC((first y).1," ") + rowList := [:rowList,elm] + y := rest y + bform := [:bform,rowList] + rowList := [] + matstring := bcwords2liststring [bcwords2liststring x for x in matform] + bstring := bcwords2liststring [bcwords2liststring x for x in bform] + prefix := STRCONC('"f02ajf(",STRINGIMAGE n,", ",STRINGIMAGE iar,", ") + prefix := STRCONC(prefix,STRINGIMAGE iai,", ",matstring,", ",bstring,", ") + prefix := STRCONC(prefix,STRINGIMAGE ifail,")") + linkGen prefix + +f02akf() == + htInitPage('"F02AKF - All eigenvalues and eigenvectors of complex matrix (Black box)",nil) + htMakePage '( + (domainConditions + (isDomain F (Float)) + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXf02akf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02akf| '|NagEigenPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\newline ") + (text . "Calculates all the eigenvalues and eigenvectors of a complex ") + (text . "matrix {\it A} of order {\it n}.") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline Order of matrix A, {\it n}: ") + (text . "\newline \tab{2} ") + (bcStrings (6 4 n PI)) +-- (text . "\blankline ") +-- (text . "\newline ") +-- (text . "\menuitemstyle{} \tab{2} ") +-- (text . "\newline First dimension of array containing real parts, ") +-- (text . " {\it iar}: \newline \tab{2} ") +-- (bcStrings (6 4 iar PI)) +-- (text . "\blankline ") +-- (text . "\newline ") +-- (text . "\menuitemstyle{} \tab{2} ") +-- (text . "\newline First dimension of array containing imaginary parts,") +-- (text . " {\it iai}: \newline \tab{2} ") +-- (bcStrings (6 4 iai F)) +-- (text . "\blankline ") +-- (text . "\newline ") +-- (text . "\menuitemstyle{} \tab{2} \newline ") +-- (text . "First dimension of array of real parts of the eigenvectors, ") +-- (text . " {\it ivr}: \newline \tab{2} ") +-- (bcStrings (6 4 ivr PI)) +-- (text . "\blankline ") +-- (text . "\newline ") +-- (text . "\menuitemstyle{} \tab{2} \newline ") +-- (text . "First dimension of array of imaginary parts of the eigenvectors,") +-- (text . " {\it ivi}: \newline \tab{2} ") +-- (bcStrings (6 4 ivi PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Ifail value: ") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'f02akfSolve) + htShowPage() + +f02akfSolve htPage == + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + iar := n +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iar) +-- objValUnwrap htpLabelSpadValue(htPage, 'iar) + iai := n +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iai) +-- objValUnwrap htpLabelSpadValue(htPage, 'iai) + ivr := n +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ivr) +-- objValUnwrap htpLabelSpadValue(htPage, 'ivr) + ivi := n +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ivi) +-- objValUnwrap htpLabelSpadValue(htPage, 'ivi) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + n = '4 => f02akfDefaultSolve(htPage,iar,iai,ivr,ivi,ifail) + matList := + "append"/[f(i,n) for i in 1..iar] where f(i,n) == + labelList := + "append"/[g(i,j) for j in 1..n] where g(i,j) == + anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) + [['bcStrings,[6, "0.0", anam, 'F]]] + prefix := ('"\newline \tab{2} ") + labelList := [['text,:prefix],:labelList] + bmatList := + "append"/[h(k,n) for k in 1..iai] where h(k,n) == + bList := + "append"/[l(k,p) for p in 1..n] where l(k,p) == + bnam := INTERN STRCONC ('"b",STRINGIMAGE k,STRINGIMAGE p) + [['bcStrings,[6, "0.0", bnam, 'F]]] + prefix := ('"\newline \tab{2} ") + bList := [['text,:prefix],:bList] + start := ('"\blankline \menuitemstyle{}\tab{2}Enter imag values of {\it A}:") + bmatList := [['text,:start],:bmatList] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :matList,:bmatList] + page := htInitPage("F02AKF - All eigenvalues and eigenvectors of complex matrix (Black box)",nil) + htSay '"\newline \menuitemstyle{}\tab{2} Enter real values of {\it A}: " + htSay '"\newline \tab{2} " + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'f02akfGen) + htpSetProperty(page,'n,n) +-- htpSetProperty(page,'iar,iar) +-- htpSetProperty(page,'iai,iai) +-- htpSetProperty(page,'ivr,ivr) +-- htpSetProperty(page,'ivi,ivi) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +f02akfDefaultSolve (htPage,iar,iai,ivr,ivi,ifail) == + n := '4 + page := htInitPage('"F02AKF - All eigenvalues and eigenvectors of complex matrix (Black box)",nil) + htMakePage '( + (domainConditions + (isDomain F (Float)) + (isDomain I (Integer))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Enter real values of {\it A}: ") + (text . "\newline \tab{2} ") + (bcStrings (6 "-21.0" a11 F)) + (bcStrings (6 "0.0" a12 F)) + (bcStrings (6 "13.6" a13 F)) + (bcStrings (6 "0.0" a14 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" a21 F)) + (bcStrings (6 "26.0" a22 F)) + (bcStrings (6 "7.5" a23 F)) + (bcStrings (6 "2.5" a24 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "-2.0" a31 F)) + (bcStrings (6 "1.68" a32 F)) + (bcStrings (6 "4.5" a33 F)) + (bcStrings (6 "1.5" a34 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" a41 F)) + (bcStrings (6 "-2.6" a42 F)) + (bcStrings (6 "-2.7" a43 F)) + (bcStrings (6 "2.5" a44 F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Enter imaginary values of {\it A}: ") + (text . "\newline \tab{2} ") + (bcStrings (6 "-5.0" b11 F)) + (bcStrings (6 "24.6" b12 F)) + (bcStrings (6 "10.2"b13 F)) + (bcStrings (6 "4.0" b14 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "22.5" b21 F)) + (bcStrings (6 "-5.0" b22 F)) + (bcStrings (6 "-10.0" b23 F)) + (bcStrings (6 "0.0" b24 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "1.5" b31 F)) + (bcStrings (6 "2.24" b32 F)) + (bcStrings (6 "-5.0" b33 F)) + (bcStrings (6 "2.0" b34 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "-2.5" b41 F)) + (bcStrings (6 "0.0" b42 F)) + (bcStrings (6 "3.6" b43 F)) + (bcStrings (6 "-5.0" b44 F))) + htMakeDoneButton('"Continue",'f02akfGen) + htpSetProperty(page,'n,n) +-- htpSetProperty(page,'iar,iar) +-- htpSetProperty(page,'iai,iai) +-- htpSetProperty(page,'ivr,ivr) +-- htpSetProperty(page,'ivi,ivi) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +f02akfGen htPage == + n := htpProperty(htPage,'n) +-- iar := htpProperty(htPage,'iar) +-- iai := htpProperty(htPage,'iai) +-- ivr := htpProperty(htPage,'ivr) +-- ivi := htpProperty(htPage,'ivi) + iar := n + iai := n + ivr := n + ivi := n + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + y := REVERSE y + for i in 1..iar repeat + for j in 1..n repeat + elm := STRCONC((first y).1," ") + rowList := [:rowList,elm] + y := rest y + matform := [:matform,rowList] + rowList := [] + for i in 1..iai repeat + for j in 1..n repeat + elm := STRCONC((first y).1," ") + rowList := [:rowList,elm] + y := rest y + bform := [:bform,rowList] + rowList := [] + matstring := bcwords2liststring [bcwords2liststring x for x in matform] + bstring := bcwords2liststring [bcwords2liststring x for x in bform] + prefix := STRCONC('"f02akf(",STRINGIMAGE iar,", ",STRINGIMAGE iai,", ") + prefix := STRCONC(prefix,STRINGIMAGE n,", ",STRINGIMAGE ivr,", ") + prefix := STRCONC(prefix,STRINGIMAGE ivi,", ",matstring,", ",bstring,", ") + prefix := STRCONC(prefix,STRINGIMAGE ifail,")") + linkGen prefix + +f02awf() == + htInitPage('"F02AWF - All eigenvalues of complex Hermitian matrix (Black box)",nil) + htMakePage '( + (domainConditions + (isDomain F (Float)) + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXf02awf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02awf| '|NagEigenPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\blankline ") + (text . "Calculates all the eigenvalues of a complex Hermitian matrix ") + (text . "{\it A} of order {\it n}.") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline Order of the complex Hermitian matrix A, {\it n}: ") + (text . "\newline \tab{2} ") + (bcStrings (6 4 n PI)) +-- (text . "\blankline ") +-- (text . "\newline ") +-- (text . "\menuitemstyle{} \tab{2} ") +-- (text . "\newline First dimension of array containing real parts, ") +-- (text . " {\it iar}: \newline \tab{2} ") +-- (bcStrings (6 4 iar PI)) +-- (text . "\blankline ") +-- (text . "\newline ") +-- (text . "\menuitemstyle{} \tab{2} ") +-- (text . "\newline First dimension of array containing imaginary parts,") +-- (text . " {\it iai}: \newline \tab{2} ") +-- (bcStrings (6 4 iai F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Ifail value: ") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'f02awfSolve) + htShowPage() + +f02awfSolve htPage == + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + iar := n +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iar) +-- objValUnwrap htpLabelSpadValue(htPage, 'iar) + iai := n +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iai) +-- objValUnwrap htpLabelSpadValue(htPage, 'iai) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + n = '4 => f02awfDefaultSolve(htPage,iar,iai,ifail) + matList := + "append"/[f(i,n) for i in 1..iar] where f(i,n) == + labelList := + "append"/[g(i,j) for j in 1..n] where g(i,j) == + anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) + [['bcStrings,[6, "0.0", anam, 'F]]] + prefix := ('"\newline \tab{2} ") + labelList := [['text,:prefix],:labelList] + bmatList := + "append"/[h(k,n) for k in 1..iai] where h(k,n) == + bList := + "append"/[l(k,p) for p in 1..n] where l(k,p) == + bnam := INTERN STRCONC ('"b",STRINGIMAGE k,STRINGIMAGE p) + [['bcStrings,[6, "0.0", bnam, 'F]]] + prefix := ('"\newline \tab{2} ") + bList := [['text,:prefix],:bList] + start := ('"\blankline \menuitemstyle{}\tab{2}Enter imaginary values {\it AI}:") + bmatList := [['text,:start],:bmatList] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :matList,:bmatList] + page := htInitPage("F02AWF - All eigenvalues of complex Hermitian matrix (Black box)",nil) + htSay '"\newline \menuitemstyle{}\tab{2} Enter real values of {\it AR}: " + htSay '"\newline \tab{2} " + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'f02awfGen) + htpSetProperty(page,'n,n) +-- htpSetProperty(page,'iar,iar) +-- htpSetProperty(page,'iai,iai) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +f02awfDefaultSolve (htPage,iar,iai,ifail) == + n := '4 + page := htInitPage('"F02AWF - All eigenvalues of complex Hermitian matrix (Black box)",nil) + htMakePage '( + (domainConditions + (isDomain F (Float)) + (isDomain I (Integer))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Enter real values {\it AR}: ") + (text . "\newline \tab{2} ") + (bcStrings (6 "0.5" a11 F)) + (bcStrings (6 "0.0" a12 F)) + (bcStrings (6 "1.84" a13 F)) + (bcStrings (6 "2.08" a14 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" a21 F)) + (bcStrings (6 "0.5" a22 F)) + (bcStrings (6 "1.12" a23 F)) + (bcStrings (6 "-0.56" a24 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "1.84" a31 F)) + (bcStrings (6 "1.12" a32 F)) + (bcStrings (6 "0.5" a33 F)) + (bcStrings (6 "0.0" a34 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "2.08" a41 F)) + (bcStrings (6 "-0.56" a42 F)) + (bcStrings (6 "0.0" a43 F)) + (bcStrings (6 "0.5" a44 F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Enter imaginary values {\it AI}: ") + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" b11 F)) + (bcStrings (6 "0.0" b12 F)) + (bcStrings (6 "1.38" b13 F)) + (bcStrings (6 "-1.56" b14 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" b21 F)) + (bcStrings (6 "0.0" b22 F)) + (bcStrings (6 "0.84" b23 F)) + (bcStrings (6 "0.42" b24 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "-1.38" b31 F)) + (bcStrings (6 "-0.84" b32 F)) + (bcStrings (6 "0.0" b33 F)) + (bcStrings (6 "0.0" b34 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "1.56" b41 F)) + (bcStrings (6 "-0.42" b42 F)) + (bcStrings (6 "0.0" b43 F)) + (bcStrings (6 "0.0" b44 F))) + htMakeDoneButton('"Continue",'f02awfGen) + htpSetProperty(page,'n,n) +-- htpSetProperty(page,'iar,iar) +-- htpSetProperty(page,'iai,iai) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +f02awfGen htPage == + n := htpProperty(htPage,'n) +-- iar := htpProperty(htPage,'iar) +-- iai := htpProperty(htPage,'iai) + iar := n + iai := n + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + y := REVERSE y + for i in 1..iar repeat + for j in 1..n repeat + elm := STRCONC((first y).1," ") + rowList := [:rowList,elm] + y := rest y + matform := [:matform,rowList] + rowList := [] + for i in 1..iai repeat + for j in 1..n repeat + elm := STRCONC((first y).1," ") + rowList := [:rowList,elm] + y := rest y + bform := [:bform,rowList] + rowList := [] + matstring := bcwords2liststring [bcwords2liststring x for x in matform] + bstring := bcwords2liststring [bcwords2liststring x for x in bform] + prefix := STRCONC('"f02awf(",STRINGIMAGE n,", ",STRINGIMAGE iar,", ") + prefix := STRCONC(prefix,STRINGIMAGE iai,", ",matstring,", ",bstring,", ") + prefix := STRCONC(prefix,STRINGIMAGE ifail,")") + linkGen prefix + +f02axf() == + htInitPage('"F02AXF - All eigenvalues and eigenvectors of complex Hermitian matrix (Black box)",nil) + htMakePage '( + (domainConditions + (isDomain F (Float)) + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXf02axf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02axf| '|NagEigenPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\newline ") + (text . "Calculates all the eigenvalues and eigenvectors of a complex ") + (text . "Hermitian matrix {\it A} of order {\it n}.") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline Order of matrix A, {\it n}: ") + (text . "\newline \tab{2} ") + (bcStrings (6 4 n PI)) +-- (text . "\blankline ") +-- (text . "\newline ") +-- (text . "\menuitemstyle{} \tab{2} ") +-- (text . "\newline First dimension of array containing real parts, ") +-- (text . " {\it iar}: \newline \tab{2} ") +-- (bcStrings (6 4 iar PI)) +-- (text . "\blankline ") +-- (text . "\newline ") +-- (text . "\menuitemstyle{} \tab{2} ") +-- (text . "\newline First dimension of array containing imaginary parts,") +-- (text . " {\it iai}: \newline \tab{2} ") +-- (bcStrings (6 4 iai F)) +-- (text . "\blankline ") +-- (text . "\newline ") +-- (text . "\menuitemstyle{} \tab{2} \newline ") +-- (text . "First dimension of array of real parts of the eigenvectors, ") +-- (text . " {\it ivr}: \newline \tab{2} ") +-- (bcStrings (6 4 ivr PI)) +-- (text . "\blankline ") +-- (text . "\newline ") +-- (text . "\menuitemstyle{} \tab{2} \newline ") +-- (text . "First dimension of array of imaginary parts of the eigenvectors,") +-- (text . " {\it ivi}: \newline \tab{2} ") +-- (bcStrings (6 4 ivi PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Ifail value: ") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'f02axfSolve) + htShowPage() + +f02axfSolve htPage == + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + iar := n +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iar) +-- objValUnwrap htpLabelSpadValue(htPage, 'iar) + iai := n +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iai) +-- objValUnwrap htpLabelSpadValue(htPage, 'iai) + ivr := n +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ivr) +-- objValUnwrap htpLabelSpadValue(htPage, 'ivr) + ivi := n +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ivi) +-- objValUnwrap htpLabelSpadValue(htPage, 'ivi) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + n = '4 => f02axfDefaultSolve(htPage,iar,iai,ivr,ivi,ifail) + matList := + "append"/[f(i,n) for i in 1..iar] where f(i,n) == + labelList := + "append"/[g(i,j) for j in 1..n] where g(i,j) == + anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) + [['bcStrings,[6, "0.0", anam, 'F]]] + prefix := ('"\newline \tab{2} ") + labelList := [['text,:prefix],:labelList] + bmatList := + "append"/[h(k,n) for k in 1..iai] where h(k,n) == + bList := + "append"/[l(k,p) for p in 1..n] where l(k,p) == + bnam := INTERN STRCONC ('"b",STRINGIMAGE k,STRINGIMAGE p) + [['bcStrings,[6, "0.0", bnam, 'F]]] + prefix := ('"\newline \tab{2} ") + bList := [['text,:prefix],:bList] + start := ('"\blankline \menuitemstyle{}\tab{2}Enter imaginary values of {\it A}:") + bmatList := [['text,:start],:bmatList] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :matList,:bmatList] + page := htInitPage("F02AXF - All eigenvalues and eigenvectors of complex Hermitian matrix (Black box)",nil) + htSay '"\newline \menuitemstyle{}\tab{2} Enter real values of {\it A}: " + htSay '"\newline \tab{2} " + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'f02axfGen) + htpSetProperty(page,'n,n) +-- htpSetProperty(page,'iar,iar) +-- htpSetProperty(page,'iai,iai) +-- htpSetProperty(page,'ivr,ivr) +-- htpSetProperty(page,'ivi,ivi) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +f02axfDefaultSolve (htPage,iar,iai,ivr,ivi,ifail) == + n := '4 + page := htInitPage('"F02AXF - All eigenvalues and eigenvectors of complex Hermitian matrix (Black box)",nil) + htMakePage '( + (domainConditions + (isDomain F (Float)) + (isDomain I (Integer))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Enter real values of {\it A}: ") + (text . "\newline \tab{2} ") + (bcStrings (6 "0.5" a11 F)) + (bcStrings (6 "0.0" a12 F)) + (bcStrings (6 "1.84" a13 F)) + (bcStrings (6 "2.08" a14 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" a21 F)) + (bcStrings (6 "0.5" a22 F)) + (bcStrings (6 "1.12" a23 F)) + (bcStrings (6 "-0.56" a24 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "1.84" a31 F)) + (bcStrings (6 "1.12" a32 F)) + (bcStrings (6 "0.5" a33 F)) + (bcStrings (6 "0.0" a34 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "2.08" a41 F)) + (bcStrings (6 "-0.56" a42 F)) + (bcStrings (6 "0.0" a43 F)) + (bcStrings (6 "0.5" a44 F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Enter imaginary values of {\it A}: ") + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" b11 F)) + (bcStrings (6 "0.0" b12 F)) + (bcStrings (6 "1.38" b13 F)) + (bcStrings (6 "-1.56" b14 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" b21 F)) + (bcStrings (6 "0.0" b22 F)) + (bcStrings (6 "0.84" b23 F)) + (bcStrings (6 "0.42" b24 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "-1.38" b31 F)) + (bcStrings (6 "-0.84" b32 F)) + (bcStrings (6 "0.0" b33 F)) + (bcStrings (6 "0.0" b34 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "1.56" b41 F)) + (bcStrings (6 "-0.42" b42 F)) + (bcStrings (6 "0.0" b43 F)) + (bcStrings (6 "0.0" b44 F))) + htMakeDoneButton('"Continue",'f02axfGen) + htpSetProperty(page,'n,n) +-- htpSetProperty(page,'iar,iar) +-- htpSetProperty(page,'iai,iai) +-- htpSetProperty(page,'ivr,ivr) +-- htpSetProperty(page,'ivi,ivi) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +f02axfGen htPage == + n := htpProperty(htPage,'n) +-- iar := htpProperty(htPage,'iar) +-- iai := htpProperty(htPage,'iai) +-- ivr := htpProperty(htPage,'ivr) +-- ivi := htpProperty(htPage,'ivi) + iar := n + iai := n + ivr := n + ivi := n + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + y := REVERSE y + for i in 1..iar repeat + for j in 1..n repeat + elm := STRCONC((first y).1," ") + rowList := [:rowList,elm] + y := rest y + matform := [:matform,rowList] + rowList := [] + for i in 1..iai repeat + for j in 1..n repeat + elm := STRCONC((first y).1," ") + rowList := [:rowList,elm] + y := rest y + bform := [:bform,rowList] + rowList := [] + matstring := bcwords2liststring [bcwords2liststring x for x in matform] + bstring := bcwords2liststring [bcwords2liststring x for x in bform] + prefix := STRCONC('"f02axf(",matstring,", ",STRINGIMAGE iar,", ",bstring) + prefix := STRCONC(prefix,", ",STRINGIMAGE iai,", ",STRINGIMAGE n,", ") + prefix := STRCONC(prefix,STRINGIMAGE ivr,", ",STRINGIMAGE ivi,", ") + prefix := STRCONC(prefix,STRINGIMAGE ifail,")") + linkGen prefix + +f02bbf() == + htInitPage('"F02BBF - Selected eigenvalues and eigenvectors of real symmetric matrix (Black box)",nil) + htMakePage '( + (domainConditions + (isDomain F (Float)) + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXf02bbf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02bbf| '|NagEigenPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\newline ") + (text . "Calculates selected eigenvalues and eigenvectors of a real ") + (text . "symmetric matrix {\it A} of order {\it n} by reduction to ") + (text . "tridiagonal form, bisection and inverse iteration, where the ") + (text . "selected eigenvalues lie within a given interval [{\it l,u}].") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline Order of matrix A, {\it n}: ") + (text . "\tab{32} \menuitemstyle{} \tab{34} ") + (text . "Max number of eigenvectors, {\it m}: ") + (text . "\newline \tab{2} ") + (bcStrings (6 4 n PI)) + (text . "\tab{34} ") + (bcStrings (6 3 m PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline Lower end-point of interval {\it l}: ") + (text . "\tab{32} \menuitemstyle{} \tab{34} ") + (text . "Upper end-point of interval {\it u}: ") + (text . "\newline \tab{2} ") + (bcStrings (6 "-2.0" alb F)) + (text . "\tab{34} ") + (bcStrings (6 "3.0" ub F)) +-- (text . "\blankline ") +-- (text . "\newline ") +-- (text . "\menuitemstyle{} \tab{2} ") +-- (text . "\newline First dimension of A, {\it ia} ") +-- (text . "\inputbitmap{\htbmdir{}/great=.bitmap} n: ") +-- (text . "\tab{32} \menuitemstyle{} \tab{34} ") +-- (text . "First dimension of V, {\it v} ") +-- (text . "\inputbitmap{\htbmdir{}/great=.bitmap} n: ") +-- (text . "\newline \tab{2} ") +-- (bcStrings (6 4 ia PI)) +-- (text . "\tab{34} ") +-- (bcStrings (6 4 iv PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Ifail value: ") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'f02bbfSolve) + htShowPage() + +f02bbfSolve htPage == + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + m := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) + objValUnwrap htpLabelSpadValue(htPage, 'm) + alb := htpLabelInputString(htPage,'alb) + ub := htpLabelInputString(htPage,'ub) + ia := n +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ia) +-- objValUnwrap htpLabelSpadValue(htPage, 'ia) + iv := n +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iv) +-- objValUnwrap htpLabelSpadValue(htPage, 'iv) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + n = '4 => f02bbfDefaultSolve(htPage,m,alb,ub,ia,iv,ifail) + matList := + "append"/[f(i,n) for i in 1..ia] where f(i,n) == + labelList := + "append"/[g(i,j) for j in 1..n] where g(i,j) == + anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) + [['bcStrings,[6, "0.0", anam, 'F]]] + prefix := ('"\newline \tab{2} ") + labelList := [['text,:prefix],:labelList] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :matList] + page := htInitPage('"F02BBF - Selected eigenvalues and eigenvectors of real symmetric matrix (Black box)",nil) + htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " + htSay '"\newline \tab{2} " + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'f02bbfGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'m,m) + htpSetProperty(page,'alb,alb) + htpSetProperty(page,'ub,ub) +-- htpSetProperty(page,'ia,ia) +-- htpSetProperty(page,'iv,iv) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +f02bbfDefaultSolve (htPage,m,alb,ub,ia,iv,ifail) == + n := '4 + page := htInitPage('"F02BBF - Selected eigenvalues and eigenvectors of real symmetric matrix (Black box)",nil) + htMakePage '( + (domainConditions + (isDomain F (Float)) + (isDomain I (Integer))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ") + (text . "\newline \tab{2} ") + (bcStrings (6 "0.5" a11 F)) + (bcStrings (6 "0.0" a12 F)) + (bcStrings (6 "2.3" a13 F)) + (bcStrings (6 "-2.6" a14 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" a21 F)) + (bcStrings (6 "0.5" a22 F)) + (bcStrings (6 "-1.4" a23 F)) + (bcStrings (6 "-0.7" a24 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "2.3" a31 F)) + (bcStrings (6 "-1.4" a32 F)) + (bcStrings (6 "0.5" a33 F)) + (bcStrings (6 "0.0" a34 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "-2.6" a41 F)) + (bcStrings (6 "-0.7" a42 F)) + (bcStrings (6 "0.0" a43 F)) + (bcStrings (6 "0.5" a44 F))) + htMakeDoneButton('"Continue",'f02bbfGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'m,m) + htpSetProperty(page,'alb,alb) + htpSetProperty(page,'ub,ub) +-- htpSetProperty(page,'ia,ia) +-- htpSetProperty(page,'iv,iv) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +f02bbfGen htPage == + n := htpProperty(htPage,'n) + m := htpProperty(htPage,'m) + alb := htpProperty(htPage,'alb) + ub := htpProperty(htPage,'ub) + -- ia should be = n, unlike the example program + -- where ia = nmax +-- ia := htpProperty(htPage,'ia) +-- iv := htpProperty(htPage,'iv) + ia := n + iv := n + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + y := REVERSE y + for i in 1..ia repeat + for j in 1..n repeat + elm := STRCONC((first y).1," ") + rowList := [:rowList,elm] + y := rest y + matform := [:matform,rowList] + rowList := [] + matstring := bcwords2liststring [bcwords2liststring x for x in matform] + prefix := STRCONC('"f02bbf(",STRINGIMAGE ia,", ",STRINGIMAGE n,", ") + prefix := STRCONC(prefix,alb,", ",ub,", ",STRINGIMAGE m,", ",STRINGIMAGE iv) + prefix := STRCONC(prefix,", ",matstring,", ",STRINGIMAGE ifail,")") + linkGen prefix + +f02bjf() == + htInitPage('"F02BJF - All eigenvalues and optionally eigenvectors of generalized eigenproblem by {\it QZ} algorithm, real matrices (Black box)",nil) + htMakePage '( + (domainConditions + (isDomain F (Float)) + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXf02bjf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02bjf| '|NagEigenPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\newline ") + (text . "Calculates all the eigenvalues and, if required, all the ") + (text . "eigenvectors of Ax = \lambda Bx, where A and B are real ") + (text . "symmetric matrices of order n and B using the QZ algorithm. ") + (text . "The routine does not actually produce the eigenvalues ") + (text . "\inputbitmap{\htbmdir{}/lamdaj.bitmap}, but instead returns ") + (text . "\inputbitmap{\htbmdir{}/alphaj.bitmap} and ") + (text . "\inputbitmap{\htbmdir{}/betaj.bitmap} ") + (text . "such that \inputbitmap{\htbmdir{}/lamdaj.bitmap} = ") + (text . "\inputbitmap{\htbmdir{}/alphaj.bitmap} / ") + (text . "\inputbitmap{\htbmdir{}/betaj.bitmap}, ") + (text . "for j = 1,2,...,n. ") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline Order of matrices A and B, {\it n}: ") + (text . "\newline \tab{2} ") + (bcStrings (6 4 n PI)) +-- (text . "\blankline ") +-- (text . "\newline ") +-- (text . "\menuitemstyle{} \tab{2} ") +-- (text . "\newline First dimension of A, {\it ia}: ") +-- (text . "\tab{32} \menuitemstyle{} \tab{34} ") +-- (text . "\newline First dimension of B, {\it ib}: ") +-- (text . "\newline \tab{2} ") +-- (bcStrings (6 4 ia PI)) +-- (text . "\tab{34} ") +-- (bcStrings (6 4 ib F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") +-- (text . "\newline First dimension of V, {\it iv}: ") +-- (text . "\tab{32} \menuitemstyle{} \tab{34} ") + (text . "\newline Tolerance, {\it eps}: ") + (text . "\newline \tab{2} ") +-- (bcStrings (6 4 iv PI)) +-- (text . "\tab{34} ") + (bcStrings (6 "1.0e-4" eps F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Are eigenvectors required: ") + (radioButtons matv + ("" " true" true) + ("" " false" false)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Ifail value: ") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'f02bjfSolve) + htShowPage() + +f02bjfSolve htPage == + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + ia := n +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ia) +-- objValUnwrap htpLabelSpadValue(htPage, 'ia) + ib := n +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ib) +-- objValUnwrap htpLabelSpadValue(htPage, 'ib) + iv := n +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iv) +-- objValUnwrap htpLabelSpadValue(htPage, 'iv) + eps := htpLabelInputString(htPage,'eps) + bool := htpButtonValue(htPage,'matv) + matv := + bool = 'true => '"true" + '"false" + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + n = '4 => f02bjfDefaultSolve(htPage,ia,ib,iv,eps,matv,ifail) + matList := + "append"/[f(i,n) for i in 1..ia] where f(i,n) == + labelList := + "append"/[g(i,j) for j in 1..n] where g(i,j) == + anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) + [['bcStrings,[6, "0.0", anam, 'F]]] + prefix := ('"\newline \tab{2} ") + labelList := [['text,:prefix],:labelList] + bmatList := + "append"/[h(k,n) for k in 1..ib] where h(k,n) == + bList := + "append"/[l(k,p) for p in 1..n] where l(k,p) == + bnam := INTERN STRCONC ('"b",STRINGIMAGE k,STRINGIMAGE p) + [['bcStrings,[6, "0.0", bnam, 'F]]] + prefix := ('"\newline \tab{2} ") + bList := [['text,:prefix],:bList] + start := ('"\blankline \menuitemstyle{} \tab{2} Enter values of {\it b}:") + bmatList := [['text,:start],:bmatList] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :matList,:bmatList] + page := htInitPage('"F02BJF - All eigenvalues and optionally eigenvectors of generalized eigenproblem by {\it QZ} algorithm, real matrices (Black box)",nil) + htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " + htSay '"\newline \tab{2} " + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'f02bjfGen) + htpSetProperty(page,'n,n) +-- htpSetProperty(page,'ia,ia) +-- htpSetProperty(page,'ib,ib) +-- htpSetProperty(page,'iv,iv) + htpSetProperty(page,'eps,eps) + htpSetProperty(page,'matv,matv) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +f02bjfDefaultSolve (htPage,ia,ib,iv,eps,matv,ifail) == + n := '4 + page := htInitPage('"F02BJF - All eigenvalues and optionally eigenvectors of generalized eigenproblem by {\it QZ} algorithm, real matrices (Black box)",nil) + htMakePage '( + (domainConditions + (isDomain F (Float)) + (isDomain I (Integer))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ") + (text . "\newline \tab{2} ") + (bcStrings (6 "3.9" a11 F)) + (bcStrings (6 "12.5" a12 F)) + (bcStrings (6 "-34.5" a13 F)) + (bcStrings (6 "-0.5" a14 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "4.3" a21 F)) + (bcStrings (6 "21.5" a22 F)) + (bcStrings (6 "-47.5" a23 F)) + (bcStrings (6 "7.5" a24 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "4.3" a31 F)) + (bcStrings (6 "21.5" a32 F)) + (bcStrings (6 "-43.5" a33 F)) + (bcStrings (6 "3.5" a34 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "4.4" a41 F)) + (bcStrings (6 "26.0" a42 F)) + (bcStrings (6 "-46.0" a43 F)) + (bcStrings (6 "6.0" a44 F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Enter values of {\it B}: ") + (text . "\newline \tab{2} ") + (bcStrings (6 1 b11 F)) + (bcStrings (6 2 b12 F)) + (bcStrings (6 "-3" b13 F)) + (bcStrings (6 1 b14 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 1 b21 F)) + (bcStrings (6 3 b22 F)) + (bcStrings (6 "-5" b23 F)) + (bcStrings (6 4b24 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 1 b31 F)) + (bcStrings (6 3 b32 F)) + (bcStrings (6 -4 b33 F)) + (bcStrings (6 3 b34 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 1 b41 F)) + (bcStrings (6 3 b42 F)) + (bcStrings (6 -4 b43 F)) + (bcStrings (6 4 b44 F))) + htMakeDoneButton('"Continue",'f02bjfGen) + htpSetProperty(page,'n,n) +-- htpSetProperty(page,'ia,ia) +-- htpSetProperty(page,'ib,ib) +-- htpSetProperty(page,'iv,iv) + htpSetProperty(page,'eps,eps) + htpSetProperty(page,'matv,matv) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +f02bjfGen htPage == + n := htpProperty(htPage,'n) +-- ia := htpProperty(htPage,'ia) +-- ib := htpProperty(htPage,'ib) +-- iv := htpProperty(htPage,'iv) + ia := n + ib := n + iv := n + eps := htpProperty(htPage,'eps) + matv := htpProperty(htPage,'matv) + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + y := REVERSE y + for i in 1..ia repeat + for j in 1..n repeat + elm := STRCONC((first y).1," ") + rowList := [:rowList,elm] + y := rest y + matform := [:matform,rowList] + rowList := [] + for i in 1..ib repeat + for j in 1..n repeat + elm := STRCONC((first y).1," ") + rowList := [:rowList,elm] + y := rest y + bform := [:bform,rowList] + rowList := [] + matstring := bcwords2liststring [bcwords2liststring x for x in matform] + bstring := bcwords2liststring [bcwords2liststring x for x in bform] + prefix := STRCONC('"f02bjf(",STRINGIMAGE n,", ",STRINGIMAGE ia,", ") + prefix := STRCONC(prefix,STRINGIMAGE ib,", ",eps,", ",matv,", ") + prefix := STRCONC(prefix,STRINGIMAGE iv,", ",matstring,", ",bstring,", ") + prefix := STRCONC(prefix,STRINGIMAGE ifail,")") + linkGen prefix + + +f02fjf() == + htInitPage('"F02FJF - Selected eigenvalues and eigenvectors of sparse symmetric eigenproblem",nil) + htMakePage '( + (domainConditions + (isDomain F (Float)) + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXf02fjf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02fjf| '|NagEigenPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\newline ") + (text . "Finds the {\it m} eigenvalues of largest absolute value and the ") + (text . "corresponding eigenvectors for the eigenvalue problem ") + (text . "{\it Cx = \htbitmap{lambda}x}, where {\it C} is a real matrix ") + (text . "of order {\it n} such that {\it BC = \htbitmap{ctb}} for a ") + (text . "given positive-definite matrix {\it B}. ") + (text . "\blankline ") + (text . "\newline ") + (text . "Read the input file to see the example program. ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "\spadcommand{)read f02fjf \bound{s0}} ")) + htShowPage() + + +f02wef() == + htInitPage('"F02WEF - SVD of real matrix",nil) + htMakePage '( + (domainConditions + (isDomain F (Float)) + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXf02wef} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02wef| '|NagEigenPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\newline ") + (text . "Returns all or part of the singular value decomposition of a ") + (text . "real {\it m} by {\it n} matrix {\it A}.") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline Rows of matrix A, {\it m}: ") + (text . "\tab{32} \menuitemstyle{} \tab{34} ") + (text . "Columns of matrix A, {\it n}: \newline \tab{2} ") + (bcStrings (6 5 m PI)) + (text . "\tab{34} ") + (bcStrings (6 3 n PI)) + (text . "\blankline ") +-- (text . "\newline ") +-- (text . "\menuitemstyle{} \tab{2} ") +-- (text . "\newline First dimension of A, {\it lda}: ") +-- (text . "\tab{32} \menuitemstyle{} \tab{34} ") +-- (text . "First dimension of B, {\it ldb}: ") +-- (text . "\newline \tab{2} ") +-- (bcStrings (6 5 lda PI)) +-- (text . "\tab{34} ") +-- (bcStrings (6 5 ldb PI)) +-- (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Number of columns of matrix B, {\it ncolb}: ") + (text . "\newline \tab{2} ") + (bcStrings (6 1 ncolb PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Is the matrix {\it Q} required, {\it wantq}:") + (radioButtons wantq + (" " " true" qtrue) + (" " " false" qfalse)) + (text . "\blankline ") +-- (text . "\newline ") +-- (text . "\menuitemstyle{} \tab{2} ") +-- (text . "\newline First dimension of {\it Q}, {\it ldq}: ") +-- (text . "\tab{32} \menuitemstyle{} \tab{34} ") +-- (text . "First dimension of {\it PT}, {\it ldpt}: ") +-- (text . "\newline \tab{2} ") +-- (bcStrings (6 1 ldq PI)) +-- (text . "\tab{34} ") +-- (bcStrings (6 5 ldpt PI)) +-- (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Is the matrix {\it PT} required, {\it wantp}:") + (radioButtons wantp + (" " " true" ptrue) + (" " " false" pfalse)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Ifail value: ") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'f02wefSolve) + htShowPage() + +f02wefSolve htPage == + m := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) + objValUnwrap htpLabelSpadValue(htPage, 'm) + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + lda := m +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lda) +-- objValUnwrap htpLabelSpadValue(htPage, 'lda) + ldb := m +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ldb) +-- objValUnwrap htpLabelSpadValue(htPage, 'ldb) + ncolb := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ncolb) + objValUnwrap htpLabelSpadValue(htPage, 'ncolb) + operation := htpButtonValue(htPage,'wantq) + wantq := + operation = 'qtrue => '"true" + '"false" + ldq := m +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ldq) +-- objValUnwrap htpLabelSpadValue(htPage, 'ldq) + ldpt := n +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ldpt) +-- objValUnwrap htpLabelSpadValue(htPage, 'ldpt) + elements := htpButtonValue(htPage,'wantp) + wantp := + elements = 'ptrue => '"true" + '"false" + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + ((m = '5 and n = '3) and ncolb = '1) => + f02wefDefaultSolve(htPage,lda,ldb,wantq,ldq,ldpt,wantp,ifail) + matList := + "append"/[fa(i,n) for i in 1..lda] where fa(i,n) == + labelList := + "append"/[ga(i,j) for j in 1..n] where ga(i,j) == + anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) + [['bcStrings,[10, "0.0", anam, 'F]]] + prefix := ('"\newline \tab{2} ") + labelList := [['text,:prefix],:labelList] + bList := + "append"/[fb(i,ncolb) for i in 1..ldb] where fb(i,ncolb) == + pre := ("\newline \tab{2} ") + labelList := + "append"/[gb(i,j) for j in 1..ncolb] where gb(i,j) == + bnam := INTERN STRCONC ('"b",STRINGIMAGE i, STRINGIMAGE j) + [['bcStrings,[6, "0.0", bnam, 'F]]] + labelList := [['text,:pre],:labelList] + prefix := ("\blankline \menuitemstyle{}\tab{2} Enter values of {\it B}: ") + bList := [['text,:prefix],:bList] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :matList,:bList] + page := htInitPage('"F02WEF - SVD of real matrix",nil) + htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " + htSay '"\newline \tab{2} " + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'f02wefGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'m,m) +-- htpSetProperty(page,'lda,lda) +-- htpSetProperty(page,'ldb,ldb) + htpSetProperty(page,'ncolb,ncolb) + htpSetProperty(page,'wantq,wantq) +-- htpSetProperty(page,'ldq,ldq) +-- htpSetProperty(page,'ldpt,ldpt) + htpSetProperty(page,'wantp,wantp) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +f02wefDefaultSolve(htPage,lda,ldb,wantq,ldq,ldpt,wantp,ifail) == + n := '3 + m := '5 + ncolb := '1 + page := htInitPage('"F02WEF - SVD of real matrix",nil) + htMakePage '( + (domainConditions + (isDomain F (Float)) + (isDomain I (Integer))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ") + (text . "\newline \tab{2} ") + (bcStrings (6 "2.0" a11 F)) + (bcStrings (6 "2.5" a12 F)) + (bcStrings (6 "2.5" a13 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "2.0" a21 F)) + (bcStrings (6 "2.5" a22 F)) + (bcStrings (6 "2.5" a23 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "1.6" a31 F)) + (bcStrings (6 "-0.4" a32 F)) + (bcStrings (6 "2.8" a33 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "2.0" a41 F)) + (bcStrings (6 "-0.5" a42 F)) + (bcStrings (6 "0.5" a43 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "1.2" a51 F)) + (bcStrings (6 "-0.3" a52 F)) + (bcStrings (6 "-2.9" a53 F)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2} Enter values of {\it B}: ") + (text . "\newline \tab{2} ") + (bcStrings (6 "1.1" b11 F)) + (bcStrings (6 "0.9" b12 F)) + (bcStrings (6 "0.6" b13 F)) + (bcStrings (6 "0.0" b14 F)) + (bcStrings (6 "-0.8" b15 F)) + (text . "\blankline ")) + htMakeDoneButton('"Continue",'f02wefGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'m,m) + htpSetProperty(page,'lda,lda) + htpSetProperty(page,'ldb,ldb) + htpSetProperty(page,'ncolb,ncolb) + htpSetProperty(page,'wantq,wantq) + htpSetProperty(page,'ldq,ldq) + htpSetProperty(page,'ldpt,ldpt) + htpSetProperty(page,'wantp,wantp) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +f02wefGen htPage == + n := htpProperty(htPage,'n) + m := htpProperty(htPage,'m) + lda := htpProperty(htPage,'lda) + ldb := htpProperty(htPage,'ldb) + ncolb := htpProperty(htPage,'ncolb) + wantq := htpProperty(htPage,'wantq) + ldq := htpProperty(htPage,'ldq) + ldpt := htpProperty(htPage,'ldpt) + wantp := htpProperty(htPage,'wantp) + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + y := REVERSE y + for i in 1..lda repeat + for j in 1..n repeat + elm := STRCONC((first y).1," ") + rowList := [:rowList,elm] + y := rest y + matform := [:matform,rowList] + rowList := [] + matstring := bcwords2liststring [bcwords2liststring x for x in matform] + for i in 1..ldb repeat + for j in 1..ncolb repeat + elm := STRCONC((first y).1," ") + rowList := [:rowList,elm] + y := rest y + bform := [:bform,rowList] + rowList := [] + bstring := bcwords2liststring [bcwords2liststring x for x in bform] + prefix := STRCONC('"f02wef(",STRINGIMAGE m,",",STRINGIMAGE n,",") + prefix := STRCONC(prefix,STRINGIMAGE lda,", ",STRINGIMAGE ncolb,", ") + prefix := STRCONC(prefix,STRINGIMAGE ldb,", ",wantq,", ") + prefix := STRCONC(prefix,STRINGIMAGE ldq,", ",wantp,", ") + prefix := STRCONC(prefix,STRINGIMAGE ldpt,", ",matstring,", ",bstring," ,") + linkGen STRCONC(prefix,STRINGIMAGE ifail,")") + +f02xef() == + htInitPage('"F02XEF - SVD of complex matrix",nil) + htMakePage '( + (domainConditions + (isDomain F (Float)) + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXf02xef} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02xef| '|NagEigenPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\newline ") + (text . "Returns all or part of the singular value decomposition of a ") + (text . "complex {\it m} by {\it n} matrix {\it A}.") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline Rows of matrix A, {\it m}: ") + (text . "\tab{32} \menuitemstyle{} \tab{34} ") + (text . "Columns of matrix A, {\it n}: \newline \tab{2} ") + (bcStrings (6 5 m PI)) + (text . "\tab{34} ") + (bcStrings (6 3 n PI)) + (text . "\blankline ") +-- (text . "\newline ") +-- (text . "\menuitemstyle{} \tab{2} ") +-- (text . "\newline First dimension of A, {\it lda}: ") +-- (text . "\tab{32} \menuitemstyle{} \tab{34} ") +-- (text . "First dimension of B, {\it ldb}: ") +-- (text . "\newline \tab{2} ") +-- (bcStrings (6 5 lda PI)) +-- (text . "\tab{34} ") +-- (bcStrings (6 5 ldb PI)) +-- (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Number of columns of matrix B, {\it ncolb}: ") + (text . "\newline \tab{2} ") + (bcStrings (6 1 ncolb PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Is the matrix {\it Q} required, {\it wantq}:") + (radioButtons wantq + (" " " true" qtrue) + (" " " false" qfalse)) + (text . "\blankline ") +-- (text . "\newline ") +-- (text . "\menuitemstyle{} \tab{2} ") +-- (text . "\newline First dimension of {\it Q}, {\it ldq}: ") +-- (text . "\tab{32} \menuitemstyle{} \tab{34} ") +-- (text . "First dimension of {\it PH}, {\it ldph}: ") +-- (text . "\newline \tab{2} ") +-- (bcStrings (6 5 ldq PI)) +-- (text . "\tab{34} ") +-- (bcStrings (6 3 ldph PI)) +-- (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Is the matrix {\it PH} required, {\it wantp}:") + (radioButtons wantp + (" " " true" ptrue) + (" " " false" pfalse)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Ifail value: ") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'f02xefSolve) + htShowPage() + +f02xefSolve htPage == + m := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) + objValUnwrap htpLabelSpadValue(htPage, 'm) + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + lda := m +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lda) +-- objValUnwrap htpLabelSpadValue(htPage, 'lda) + ldb := m +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ldb) +-- objValUnwrap htpLabelSpadValue(htPage, 'ldb) + ncolb := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ncolb) + objValUnwrap htpLabelSpadValue(htPage, 'ncolb) + operation := htpButtonValue(htPage,'wantq) + wantq := + operation = 'qtrue => '"true" + '"false" + ldq := m +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ldq) +-- objValUnwrap htpLabelSpadValue(htPage, 'ldq) + ldph := n +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ldph) +-- objValUnwrap htpLabelSpadValue(htPage, 'ldph) + elements := htpButtonValue(htPage,'wantp) + wantp := + elements = 'ptrue => '"true" + '"false" + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + ((m = '5 and n = '3) and ncolb = '1) => + f02xefDefaultSolve(htPage,lda,ldb,wantq,ldq,ldph,wantp,ifail) + matList := + "append"/[fa(i,n) for i in 1..lda] where fa(i,n) == + labelList := + "append"/[ga(i,j) for j in 1..n] where ga(i,j) == + anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) + [['bcStrings,[15, "0.0", anam, 'F]]] + prefix := ('"\newline \tab{2} ") + labelList := [['text,:prefix],:labelList] + bList := + "append"/[fb(i,ncolb) for i in 1..ldb] where fb(i,ncolb) == + pre := ("\newline \tab{2} ") + labelList := + "append"/[gb(i,j) for j in 1..ncolb] where gb(i,j) == + bnam := INTERN STRCONC ('"b",STRINGIMAGE i, STRINGIMAGE j) + [['bcStrings,[15, "0.0", bnam, 'F]]] + labelList := [['text,:pre],:labelList] + prefix := ("\blankline \menuitemstyle{}\tab{2} Enter values of {\it B}: ") + bList := [['text,:prefix],:bList] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :matList,:bList] + page := htInitPage('"F02XEF - SVD of complex matrix",nil) + htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " + htSay '"\newline \tab{2} " + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'f02xefGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'m,m) + htpSetProperty(page,'lda,lda) + htpSetProperty(page,'ldb,ldb) + htpSetProperty(page,'ncolb,ncolb) + htpSetProperty(page,'wantq,wantq) + htpSetProperty(page,'ldq,ldq) + htpSetProperty(page,'ldph,ldph) + htpSetProperty(page,'wantp,wantp) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +f02xefDefaultSolve(htPage,lda,ldb,wantq,ldq,ldph,wantp,ifail) == + n := '3 + m := '5 + ncolb := '1 + page := htInitPage('"F02XEF - SVD of complex matrix",nil) + htMakePage '( + (domainConditions + (isDomain F (Float)) + (isDomain I (Integer))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ") + (text . "\newline \tab{2} ") + (bcStrings (15 "0.5*%i" a11 F)) + (bcStrings (15 "-0.5 + 1.5*%i" a12 F)) + (bcStrings (15 "-1 + 1*%i" a13 F)) + (text . "\newline \tab{2} ") + (bcStrings (15 "0.4 + 0.3*%i" a21 F)) + (bcStrings (15 "0.9 + 1.3*%i" a22 F)) + (bcStrings (15 "0.2 + 1.4*%i" a23 F)) + (text . "\newline \tab{2} ") + (bcStrings (15 "0.4" a31 F)) + (bcStrings (15 "-0.4 + 0.4*%i" a32 F)) + (bcStrings (15 "1.8" a33 F)) + (text . "\newline \tab{2} ") + (bcStrings (15 "0.3 - 0.4*%i" a41 F)) + (bcStrings (15 "0.1 + 0.7*%i" a42 F)) + (bcStrings (15 "0.0" a43 F)) + (text . "\newline \tab{2} ") + (bcStrings (15 "-0.3*%i" a51 F)) + (bcStrings (15 "0.3 + 0.3*%i" a52 F)) + (bcStrings (15 "2.4*%i" a53 F)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2} Enter values of {\it B}: ") + (text . "\newline \tab{2} ") + (bcStrings (15 "-0.55+1.05*%i" b11 F)) + (text . "\newline \tab{2} ") + (bcStrings (15 "0.49+0.93*%i" b12 F)) + (text . "\newline \tab{2} ") + (bcStrings (15 "0.56-0.16*%i" b13 F)) + (text . "\newline \tab{2} ") + (bcStrings (15 "0.39+0.23*%i" b14 F)) + (text . "\newline \tab{2} ") + (bcStrings (15 "1.13+0.83*%i" b15 F)) + (text . "\blankline ")) + htMakeDoneButton('"Continue",'f02xefGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'m,m) + htpSetProperty(page,'lda,lda) + htpSetProperty(page,'ldb,ldb) + htpSetProperty(page,'ncolb,ncolb) + htpSetProperty(page,'wantq,wantq) + htpSetProperty(page,'ldq,ldq) + htpSetProperty(page,'ldph,ldph) + htpSetProperty(page,'wantp,wantp) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +f02xefGen htPage == + n := htpProperty(htPage,'n) + m := htpProperty(htPage,'m) + lda := htpProperty(htPage,'lda) + ldb := htpProperty(htPage,'ldb) + ncolb := htpProperty(htPage,'ncolb) + wantq := htpProperty(htPage,'wantq) + ldq := htpProperty(htPage,'ldq) + ldph := htpProperty(htPage,'ldph) + wantp := htpProperty(htPage,'wantp) + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + y := REVERSE y + for i in 1..lda repeat + for j in 1..n repeat + elm := STRCONC((first y).1," ") + rowList := [:rowList,elm] + y := rest y + matform := [:matform,rowList] + rowList := [] + matstring := bcwords2liststring [bcwords2liststring x for x in matform] + for i in 1..ldb repeat + for j in 1..ncolb repeat + elm := STRCONC((first y).1," ") + rowList := [:rowList,elm] + y := rest y + bform := [:bform,rowList] + rowList := [] + bstring := bcwords2liststring [bcwords2liststring x for x in bform] + prefix := STRCONC('"f02xef(",STRINGIMAGE m,",",STRINGIMAGE n,",") + prefix := STRCONC(prefix,STRINGIMAGE lda,", ",STRINGIMAGE ncolb,", ") + prefix := STRCONC(prefix,STRINGIMAGE ldb,", ",wantq,", ") + prefix := STRCONC(prefix,STRINGIMAGE ldq,", ",wantp,", ") + prefix := STRCONC(prefix,STRINGIMAGE ldph,", ",matstring,", ",bstring," ,") + linkGen STRCONC(prefix,STRINGIMAGE ifail,")") + + diff --git a/src/interp/nag-f02.boot.pamphlet b/src/interp/nag-f02.boot.pamphlet deleted file mode 100644 index e19d9df5..00000000 --- a/src/interp/nag-f02.boot.pamphlet +++ /dev/null @@ -1,2757 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp nag-f02.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. - -@ -<<*>>= -<> - -)package "BOOT" - -f02aaf() == - htInitPage('"F02AAF - All eigenvalues of real symmetric matrix (Black box)",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXf02aaf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02aaf| '|NagEigenPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "Calculates all the eigenvalues of a real symmetric matrix ") - (text . "{\it A} of order {\it n}.") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline Order of matrix A, {\it n}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 4 n PI)) --- (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{} \tab{2} ") --- (text . "\newline First dimension of A, {\it ia} ") --- (text . "\inputbitmap{\htbmdir{}/great=.bitmap} n: ") --- (text . "\newline \tab{2} ") --- (bcStrings (6 4 ia PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'f02aafSolve) - htShowPage() - -f02aafSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - ia := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ia) --- objValUnwrap htpLabelSpadValue(htPage, 'ia) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - n = '4 => f02aafDefaultSolve(htPage,ia,ifail) - matList := - "append"/[f(i,n) for i in 1..ia] where f(i,n) == - labelList := - "append"/[g(i,j) for j in 1..n] where g(i,j) == - anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) - [['bcStrings,[6, "0.0", anam, 'F]]] - prefix := ('"\newline \tab{2} ") - labelList := [['text,:prefix],:labelList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :matList] - page := htInitPage("F02AAF - All eigenvalues of real symmetric matrix (Black box)",nil) - htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " - htSay '"\newline \tab{2} " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'f02aafGen) - htpSetProperty(page,'n,n) --- htpSetProperty(page,'ia,ia) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -f02aafDefaultSolve (htPage,ia,ifail) == - n := '4 - page := htInitPage('"F02AAF - All eigenvalues of real symmetric matrix (Black box)",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 "0.5" a11 F)) - (bcStrings (6 "0.0" a12 F)) - (bcStrings (6 "2.3" a13 F)) - (bcStrings (6 "-2.6" a14 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" a21 F)) - (bcStrings (6 "0.5" a22 F)) - (bcStrings (6 "-1.4" a23 F)) - (bcStrings (6 "-0.7" a24 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "2.3" a31 F)) - (bcStrings (6 "-1.4" a32 F)) - (bcStrings (6 "0.5" a33 F)) - (bcStrings (6 "0.0" a34 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "-2.6" a41 F)) - (bcStrings (6 "-0.7" a42 F)) - (bcStrings (6 "0.0" a43 F)) - (bcStrings (6 "0.5" a44 F))) - htMakeDoneButton('"Continue",'f02aafGen) - htpSetProperty(page,'n,n) --- htpSetProperty(page,'ia,ia) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f02aafGen htPage == - n := htpProperty(htPage,'n) - -- ia should be = n, unlike the example program - -- where ia = nmax --- ia := htpProperty(htPage,'ia) - ia := n - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - y := REVERSE y - for i in 1..ia repeat - for j in 1..n repeat - elm := STRCONC((first y).1," ") - rowList := [:rowList,elm] - y := rest y - matform := [:matform,rowList] - rowList := [] - matstring := bcwords2liststring [bcwords2liststring x for x in matform] - prefix := STRCONC('"f02aaf(",STRINGIMAGE ia,", ",STRINGIMAGE n,", ") - prefix := STRCONC(prefix,matstring,", ",STRINGIMAGE ifail,")") - linkGen prefix - -f02abf() == - htInitPage('"F02ABF - All eigenvalues and eignevectors of real symmetric matrix (Black box)",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXf02abf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02abf| '|NagEigenPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "Calculates all the eigenvalues and eigenvectors of a real ") - (text . "symmetric matrix ") - (text . "{\it A} of order {\it n}.") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline Order of matrix A, {\it n}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 4 n PI)) --- (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{} \tab{2} ") --- (text . "\newline First dimension of A, {\it ia} ") --- (text . "\inputbitmap{\htbmdir{}/great=.bitmap} n: ") --- (text . "\tab{32} \menuitemstyle{} \tab{34} ") --- (text . "First dimension of V, {\it v} ") --- (text . "\inputbitmap{\htbmdir{}/great=.bitmap} n: ") --- (text . "\newline \tab{2} ") --- (bcStrings (6 4 ia PI)) --- (text . "\tab{34} ") --- (bcStrings (6 4 v PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'f02abfSolve) - htShowPage() - -f02abfSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - ia := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ia) --- objValUnwrap htpLabelSpadValue(htPage, 'ia) - iv := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'v) --- objValUnwrap htpLabelSpadValue(htPage, 'v) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - n = '4 => f02abfDefaultSolve(htPage,ia,iv,ifail) - matList := - "append"/[f(i,n) for i in 1..ia] where f(i,n) == - labelList := - "append"/[g(i,j) for j in 1..n] where g(i,j) == - anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) - [['bcStrings,[6, "0.0", anam, 'F]]] - prefix := ('"\newline \tab{2} ") - labelList := [['text,:prefix],:labelList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :matList] - page := htInitPage("F02ABF - All eigenvalues and eigenvectors of real symmetric matrix (Black box)",nil) - htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " - htSay '"\newline \tab{2} " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'f02abfGen) - htpSetProperty(page,'n,n) --- htpSetProperty(page,'ia,ia) --- htpSetProperty(page,'iv,iv) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -f02abfDefaultSolve (htPage,ia,iv,ifail) == - n := '4 - page := htInitPage('"F02ABF - All eigenvalues and eigenvectors of real symmetric matrix (Black box)",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 "0.5" a11 F)) - (bcStrings (6 "0.0" a12 F)) - (bcStrings (6 "2.3" a13 F)) - (bcStrings (6 "-2.6" a14 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" a21 F)) - (bcStrings (6 "0.5" a22 F)) - (bcStrings (6 "-1.4" a23 F)) - (bcStrings (6 "-0.7" a24 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "2.3" a31 F)) - (bcStrings (6 "-1.4" a32 F)) - (bcStrings (6 "0.5" a33 F)) - (bcStrings (6 "0.0" a34 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "-2.6" a41 F)) - (bcStrings (6 "-0.7" a42 F)) - (bcStrings (6 "0.0" a43 F)) - (bcStrings (6 "0.5" a44 F))) - htMakeDoneButton('"Continue",'f02abfGen) - htpSetProperty(page,'n,n) --- htpSetProperty(page,'ia,ia) --- htpSetProperty(page,'iv,iv) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f02abfGen htPage == - n := htpProperty(htPage,'n) - -- ia should be = n, unlike the example program - -- where ia = nmax --- ia := htpProperty(htPage,'ia) --- iv := htpProperty(htPage,'iv) - ia := n - iv := n - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - y := REVERSE y - for i in 1..ia repeat - for j in 1..n repeat - elm := STRCONC((first y).1," ") - rowList := [:rowList,elm] - y := rest y - matform := [:matform,rowList] - rowList := [] - matstring := bcwords2liststring [bcwords2liststring x for x in matform] - prefix := STRCONC('"f02abf(",matstring,", ",STRINGIMAGE ia,", ") - prefix := STRCONC(prefix,STRINGIMAGE n,", ",STRINGIMAGE iv,", ") - linkGen STRCONC(prefix,STRINGIMAGE ifail,")") - -f02adf() == - htInitPage('"F02ADF - All eigenvalues of generalized real eigenproblem of the form Ax = \lambda Bx where A and B are symmetric and B is positive definite",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXf02adf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02adf| '|NagEigenPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\blankline ") - (text . "Calculates all the eigenvalues of Ax = \lambda Bx, where ") - (text . "A and B are real symmetric matrices of order n and B is positive-definite ") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline Order of matrices A and B, {\it n}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 4 n PI)) --- (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{} \tab{2} ") --- (text . "\newline First dimension of A, {\it ia}: ") --- (text . "\tab{32} \menuitemstyle{} \tab{34} ") --- (text . "\newline First dimension of B, {\it ib}: ") --- (text . "\newline \tab{2} ") --- (bcStrings (6 4 ia PI)) --- (text . "\tab{34} ") --- (bcStrings (6 4 ib F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'f02adfSolve) - htShowPage() - -f02adfSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - ia := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ia) --- objValUnwrap htpLabelSpadValue(htPage, 'ia) - ib := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ib) --- objValUnwrap htpLabelSpadValue(htPage, 'ib) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - n = '4 => f02adfDefaultSolve(htPage,ia,ib,ifail) - matList := - "append"/[f(i,n) for i in 1..ia] where f(i,n) == - labelList := - "append"/[g(i,j) for j in 1..n] where g(i,j) == - anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) - [['bcStrings,[6, "0.0", anam, 'F]]] - prefix := ('"\newline \tab{2} ") - labelList := [['text,:prefix],:labelList] - bmatList := - "append"/[h(k,n) for k in 1..ib] where h(k,n) == - bList := - "append"/[l(k,p) for p in 1..n] where l(k,p) == - bnam := INTERN STRCONC ('"b",STRINGIMAGE k,STRINGIMAGE p) - [['bcStrings,[6, "0.0", bnam, 'F]]] - prefix := ('"\newline \tab{2} ") - bList := [['text,:prefix],:bList] - start := ('"\blankline \menuitemstyle{} \tab{2} Enter values of {\it b}:") - bmatList := [['text,:start],:bmatList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :matList,:bmatList] - page := htInitPage("F02ADF - All eigenvalues of generalized real eigenproblem of the form Ax = \lambda Bx where A and B are symmetric and B is positive definite",nil) - htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " - htSay '"\newline \tab{2} " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'f02adfGen) - htpSetProperty(page,'n,n) --- htpSetProperty(page,'ia,ia) --- htpSetProperty(page,'ib,ib) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -f02adfDefaultSolve (htPage,ia,ib,ifail) == - n := '4 - page := htInitPage('"F02ADF - All eigenvalues of generalized real eigenproblem of the form Ax = \lambda Bx where A and B are symmetric and B is positive definite",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 "0.5" a11 F)) - (bcStrings (6 "1.5" a12 F)) - (bcStrings (6 "6.6" a13 F)) - (bcStrings (6 "4.8" a14 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "1.5" a21 F)) - (bcStrings (6 "6.5" a22 F)) - (bcStrings (6 "16.2" a23 F)) - (bcStrings (6 "8.6" a24 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "6.6" a31 F)) - (bcStrings (6 "16.2" a32 F)) - (bcStrings (6 "37.6" a33 F)) - (bcStrings (6 "9.8" a34 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "4.8" a41 F)) - (bcStrings (6 "8.6" a42 F)) - (bcStrings (6 "9.8" a43 F)) - (bcStrings (6 "-17.1" a44 F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter values of {\it B}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 1 b11 F)) - (bcStrings (6 3 b12 F)) - (bcStrings (6 4 b13 F)) - (bcStrings (6 1 b14 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 3 b21 F)) - (bcStrings (6 13 b22 F)) - (bcStrings (6 16 b23 F)) - (bcStrings (6 11 b24 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 4 b31 F)) - (bcStrings (6 16 b32 F)) - (bcStrings (6 24 b33 F)) - (bcStrings (6 18 b34 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 1 b41 F)) - (bcStrings (6 11 b42 F)) - (bcStrings (6 18 b43 F)) - (bcStrings (6 27 b44 F))) - htMakeDoneButton('"Continue",'f02adfGen) - htpSetProperty(page,'n,n) --- htpSetProperty(page,'ia,ia) --- htpSetProperty(page,'ib,ib) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f02adfGen htPage == - n := htpProperty(htPage,'n) --- ia := htpProperty(htPage,'ia) --- ib := htpProperty(htPage,'ib) - ia := n - ib := n - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - y := REVERSE y - for i in 1..ia repeat - for j in 1..n repeat - elm := STRCONC((first y).1," ") - rowList := [:rowList,elm] - y := rest y - matform := [:matform,rowList] - rowList := [] - for i in 1..ib repeat - for j in 1..n repeat - elm := STRCONC((first y).1," ") - rowList := [:rowList,elm] - y := rest y - bform := [:bform,rowList] - rowList := [] - matstring := bcwords2liststring [bcwords2liststring x for x in matform] - bstring := bcwords2liststring [bcwords2liststring x for x in bform] - prefix := STRCONC('"f02adf(",STRINGIMAGE ia,", ",STRINGIMAGE ib,", ") - prefix := STRCONC(prefix,STRINGIMAGE n,", ",matstring,", ",bstring,", ") - prefix := STRCONC(prefix,STRINGIMAGE ifail,")") - linkGen prefix - -f02aef() == - htInitPage('"F02AEF - All eigenvalues and eigenvectors of generalized real eigenproblem of the form Ax = \lambda Bx where A and B are symmetric and B is positive definite",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXf02aef} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02aef| '|NagEigenPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\blankline ") - (text . "Calculates all the eigenvalues and eigenvectors of Ax = ") - (text . "\lambda Bx, where A and B are real symmetric matrices of order ") - (text . "n and B is positive-definite ") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline Order of matrices A and B, {\it n}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 4 n PI)) --- (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{} \tab{2} ") --- (text . "\newline First dimension of A, {\it ia}: ") --- (text . "\tab{32} \menuitemstyle{} \tab{34} ") --- (text . "\newline First dimension of B, {\it ib}: ") --- (text . "\newline \tab{2} ") --- (bcStrings (6 4 ia PI)) --- (text . "\tab{34} ") --- (bcStrings (6 4 ib F)) --- (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{} \tab{2} ") --- (text . "\newline First dimension of V, {\it iv}: ") --- (text . "\newline \tab{2} ") --- (bcStrings (6 4 iv PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'f02aefSolve) - htShowPage() - -f02aefSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - ia := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ia) --- objValUnwrap htpLabelSpadValue(htPage, 'ia) - ib := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ib) --- objValUnwrap htpLabelSpadValue(htPage, 'ib) - iv := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iv) --- objValUnwrap htpLabelSpadValue(htPage, 'iv) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - n = '4 => f02aefDefaultSolve(htPage,ia,ib,iv,ifail) - matList := - "append"/[f(i,n) for i in 1..ia] where f(i,n) == - labelList := - "append"/[g(i,j) for j in 1..n] where g(i,j) == - anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) - [['bcStrings,[6, "0.0", anam, 'F]]] - prefix := ('"\newline \tab{2} ") - labelList := [['text,:prefix],:labelList] - bmatList := - "append"/[h(k,n) for k in 1..ib] where h(k,n) == - bList := - "append"/[l(k,p) for p in 1..n] where l(k,p) == - bnam := INTERN STRCONC ('"b",STRINGIMAGE k,STRINGIMAGE p) - [['bcStrings,[6, "0.0", bnam, 'F]]] - prefix := ('"\newline \tab{2} ") - bList := [['text,:prefix],:bList] - start := ('"\blankline \menuitemstyle{} \tab{2} Enter values of {\it b}:") - bmatList := [['text,:start],:bmatList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :matList,:bmatList] - page := htInitPage("F02AEF - All eigenvalues and eigenvectors of generalized real eigenproblem of the form Ax = \lambda Bx where A and B are symmetric and B is positive definite",nil) - htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " - htSay '"\newline \tab{2} " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'f02aefGen) - htpSetProperty(page,'n,n) --- htpSetProperty(page,'ia,ia) --- htpSetProperty(page,'ib,ib) --- htpSetProperty(page,'iv,iv) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -f02aefDefaultSolve (htPage,ia,ib,iv,ifail) == - n := '4 - page := htInitPage('"F02AEF - All eigenvalues and eigenvectors of generalized real eigenproblem of the form Ax = \lambda Bx where A and B are symmetric and B is positive definite",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 "0.5" a11 F)) - (bcStrings (6 "1.5" a12 F)) - (bcStrings (6 "6.6" a13 F)) - (bcStrings (6 "4.8" a14 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "1.5" a21 F)) - (bcStrings (6 "6.5" a22 F)) - (bcStrings (6 "16.2" a23 F)) - (bcStrings (6 "8.6" a24 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "6.6" a31 F)) - (bcStrings (6 "16.2" a32 F)) - (bcStrings (6 "37.6" a33 F)) - (bcStrings (6 "9.8" a34 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "4.8" a41 F)) - (bcStrings (6 "8.6" a42 F)) - (bcStrings (6 "9.8" a43 F)) - (bcStrings (6 "-17.1" a44 F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter values of {\it B}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 1 b11 F)) - (bcStrings (6 3 b12 F)) - (bcStrings (6 4 b13 F)) - (bcStrings (6 1 b14 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 3 b21 F)) - (bcStrings (6 13 b22 F)) - (bcStrings (6 16 b23 F)) - (bcStrings (6 11 b24 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 4 b31 F)) - (bcStrings (6 16 b32 F)) - (bcStrings (6 24 b33 F)) - (bcStrings (6 18 b34 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 1 b41 F)) - (bcStrings (6 11 b42 F)) - (bcStrings (6 18 b43 F)) - (bcStrings (6 27 b44 F))) - htMakeDoneButton('"Continue",'f02aefGen) - htpSetProperty(page,'n,n) --- htpSetProperty(page,'ia,ia) --- htpSetProperty(page,'ib,ib) --- htpSetProperty(page,'iv,iv) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f02aefGen htPage == - n := htpProperty(htPage,'n) --- ia := htpProperty(htPage,'ia) --- ib := htpProperty(htPage,'ib) --- iv := htpProperty(htPage,'iv) - ia := n - ib := n - iv := n - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - y := REVERSE y - for i in 1..ia repeat - for j in 1..n repeat - elm := STRCONC((first y).1," ") - rowList := [:rowList,elm] - y := rest y - matform := [:matform,rowList] - rowList := [] - for i in 1..ib repeat - for j in 1..n repeat - elm := STRCONC((first y).1," ") - rowList := [:rowList,elm] - y := rest y - bform := [:bform,rowList] - rowList := [] - matstring := bcwords2liststring [bcwords2liststring x for x in matform] - bstring := bcwords2liststring [bcwords2liststring x for x in bform] - prefix := STRCONC('"f02aef(",STRINGIMAGE ia,", ",STRINGIMAGE ib,", ") - prefix := STRCONC(prefix,STRINGIMAGE n,", ",STRINGIMAGE iv,", ") - prefix := STRCONC(prefix,matstring,", ",bstring,", ") - prefix := STRCONC(prefix,STRINGIMAGE ifail,")") - linkGen prefix - - -f02aff() == - htInitPage('"F02AFF - All eigenvalues of real matrix (Black box)",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXf02aff} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02aff| '|NagEigenPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "Calculates all the eigenvalues of a real unsymmetric matrix ") - (text . "{\it A} of order {\it n}.") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline Order of matrix A, {\it n}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 4 n PI)) --- (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{} \tab{2} ") --- (text . "\newline First dimension of A, {\it ia} ") --- (text . "\inputbitmap{\htbmdir{}/great=.bitmap} n: ") --- (text . "\newline \tab{2} ") --- (bcStrings (6 4 ia PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'f02affSolve) - htShowPage() - -f02affSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - ia := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ia) --- objValUnwrap htpLabelSpadValue(htPage, 'ia) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - n = '4 => f02affDefaultSolve(htPage,ia,ifail) - matList := - "append"/[f(i,n) for i in 1..ia] where f(i,n) == - labelList := - "append"/[g(i,j) for j in 1..n] where g(i,j) == - anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) - [['bcStrings,[6, "0.0", anam, 'F]]] - prefix := ('"\newline \tab{2} ") - labelList := [['text,:prefix],:labelList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :matList] - page := htInitPage("F02AFF - All eigenvalues of real matrix (Black box)",nil) - htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " - htSay '"\newline \tab{2} " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'f02affGen) - htpSetProperty(page,'n,n) --- htpSetProperty(page,'ia,ia) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -f02affDefaultSolve (htPage,ia,ifail) == - n := '4 - page := htInitPage('"F02AFF - All eigenvalues of real matrix (Black box)",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 "1.5" a11 F)) - (bcStrings (6 "0.1" a12 F)) - (bcStrings (6 "4.5" a13 F)) - (bcStrings (6 "-1.5" a14 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "-22.5" a21 F)) - (bcStrings (6 "3.5" a22 F)) - (bcStrings (6 "12.5" a23 F)) - (bcStrings (6 "-2.5" a24 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "-2.5" a31 F)) - (bcStrings (6 "0.3" a32 F)) - (bcStrings (6 "4.5" a33 F)) - (bcStrings (6 "-2.5" a34 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "-2.5" a41 F)) - (bcStrings (6 "0.1" a42 F)) - (bcStrings (6 "4.5" a43 F)) - (bcStrings (6 "2.5" a44 F))) - htMakeDoneButton('"Continue",'f02affGen) - htpSetProperty(page,'n,n) --- htpSetProperty(page,'ia,ia) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f02affGen htPage == - n := htpProperty(htPage,'n) - -- ia should be = n, unlike the example program - -- where ia = nmax --- ia := htpProperty(htPage,'ia) - ia := n - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - y := REVERSE y - for i in 1..ia repeat - for j in 1..n repeat - elm := STRCONC((first y).1," ") - rowList := [:rowList,elm] - y := rest y - matform := [:matform,rowList] - rowList := [] - matstring := bcwords2liststring [bcwords2liststring x for x in matform] - prefix := STRCONC('"f02aff(",STRINGIMAGE ia,", ",STRINGIMAGE n,", ") - prefix := STRCONC(prefix,matstring,", ",STRINGIMAGE ifail,")") - linkGen prefix - -f02agf() == - htInitPage('"F02AGF - All eigenvalues and eignevectors of real matrix (Black box)",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXf02agf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02agf| '|NagEigenPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "Calculates all the eigenvalues and eigenvectors of a real ") - (text . "unsymmetric matrix {\it A} of order {\it n}.") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline Order of matrix A, {\it n}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 4 n PI)) --- (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{} \tab{2} ") --- (text . "\newline First dimension of A, {\it ia} ") --- (text . "\inputbitmap{\htbmdir{}/great=.bitmap} n: ") --- (text . "\tab{32} \menuitemstyle{} \tab{34} ") --- (text . "First dimension of VR, {\it ivr} ") --- (text . "\inputbitmap{\htbmdir{}/great=.bitmap} n: ") --- (text . "\newline \tab{2} ") --- (bcStrings (6 4 ia PI)) --- (text . "\tab{34} ") --- (bcStrings (6 4 ivr PI)) --- (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{} \tab{2} ") --- (text . "\newline First dimension of VI, {\it ivi} ") --- (text . "\inputbitmap{\htbmdir{}/great=.bitmap} n: ") --- (text . "\newline \tab{2} ") --- (bcStrings (6 4 ivi PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'f02agfSolve) - htShowPage() - -f02agfSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - ia := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ia) --- objValUnwrap htpLabelSpadValue(htPage, 'ia) - ivr := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ivr) --- objValUnwrap htpLabelSpadValue(htPage, 'ivr) - ivi := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ivi) --- objValUnwrap htpLabelSpadValue(htPage, 'ivi) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - n = '4 => f02agfDefaultSolve(htPage,ia,ivr,ivi,ifail) - matList := - "append"/[f(i,n) for i in 1..ia] where f(i,n) == - labelList := - "append"/[g(i,j) for j in 1..n] where g(i,j) == - anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) - [['bcStrings,[6, "0.0", anam, 'F]]] - prefix := ('"\newline \tab{2} ") - labelList := [['text,:prefix],:labelList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :matList] - page := htInitPage("F02AGF - All eigenvalues and eigenvectors of real matrix (Black box)",nil) - htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " - htSay '"\newline \tab{2} " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'f02agfGen) - htpSetProperty(page,'n,n) --- htpSetProperty(page,'ia,ia) --- htpSetProperty(page,'ivr,ivr) --- htpSetProperty(page,'ivi,ivi) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -f02agfDefaultSolve (htPage,ia,ivr,ivi,ifail) == - n := '4 - page := htInitPage('"F02AGF - All eigenvalues and eigenvectors of real matrix (Black box)",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 "1.5" a11 F)) - (bcStrings (6 "0.1" a12 F)) - (bcStrings (6 "4.5" a13 F)) - (bcStrings (6 "-1.5" a14 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "-22.5" a21 F)) - (bcStrings (6 "3.5" a22 F)) - (bcStrings (6 "12.5" a23 F)) - (bcStrings (6 "-2.5" a24 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "-2.5" a31 F)) - (bcStrings (6 "0.3" a32 F)) - (bcStrings (6 "4.5" a33 F)) - (bcStrings (6 "-2.5" a34 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "-2.5" a41 F)) - (bcStrings (6 "0.1" a42 F)) - (bcStrings (6 "4.5" a43 F)) - (bcStrings (6 "2.5" a44 F))) - htMakeDoneButton('"Continue",'f02agfGen) - htpSetProperty(page,'n,n) --- htpSetProperty(page,'ia,ia) --- htpSetProperty(page,'ivr,ivr) --- htpSetProperty(page,'ivi,ivi) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f02agfGen htPage == - n := htpProperty(htPage,'n) - -- ia should be = n, unlike the example program - -- where ia = nmax --- ia := htpProperty(htPage,'ia) --- ivr := htpProperty(htPage,'ivr) --- ivi := htpProperty(htPage,'ivi) - ia := n - ivr := n - ivi := n - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - y := REVERSE y - for i in 1..ia repeat - for j in 1..n repeat - elm := STRCONC((first y).1," ") - rowList := [:rowList,elm] - y := rest y - matform := [:matform,rowList] - rowList := [] - matstring := bcwords2liststring [bcwords2liststring x for x in matform] - prefix := STRCONC('"f02agf(",STRINGIMAGE ia,", ",STRINGIMAGE n,", ") - prefix := STRCONC(prefix,STRINGIMAGE ivr,", ",STRINGIMAGE ivi,", ") - linkGen STRCONC(prefix,matstring,", ",STRINGIMAGE ifail,")") - -f02ajf() == - htInitPage('"F02AJF - All eigenvalues of complex matrix (Black box)",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXf02ajf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02ajf| '|NagEigenPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\blankline ") - (text . "Calculates all the eigenvalues of a complex matrix {\it A} ") - (text . "of order {\it n}.") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline Order of matrix A, {\it n}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 4 n PI)) --- (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{} \tab{2} ") --- (text . "\newline First dimension of array containing real parts, ") --- (text . " {\it iar}: \newline \tab{2} ") --- (bcStrings (6 4 iar PI)) --- (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{} \tab{2} ") --- (text . "\newline First dimension of array containing imaginary parts,") --- (text . " {\it iai}: \newline \tab{2} ") --- (bcStrings (6 4 iai F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'f02ajfSolve) - htShowPage() - -f02ajfSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - iar := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iar) --- objValUnwrap htpLabelSpadValue(htPage, 'iar) - iai := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iai) --- objValUnwrap htpLabelSpadValue(htPage, 'iai) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - n = '4 => f02ajfDefaultSolve(htPage,iar,iai,ifail) - matList := - "append"/[f(i,n) for i in 1..iar] where f(i,n) == - labelList := - "append"/[g(i,j) for j in 1..n] where g(i,j) == - anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) - [['bcStrings,[6, "0.0", anam, 'F]]] - prefix := ('"\newline \tab{2} ") - labelList := [['text,:prefix],:labelList] - bmatList := - "append"/[h(k,n) for k in 1..iai] where h(k,n) == - bList := - "append"/[l(k,p) for p in 1..n] where l(k,p) == - bnam := INTERN STRCONC ('"b",STRINGIMAGE k,STRINGIMAGE p) - [['bcStrings,[6, "0.0", bnam, 'F]]] - prefix := ('"\newline \tab{2} ") - bList := [['text,:prefix],:bList] - start := ('"\blankline \menuitemstyle{}\tab{2}Enter imag values of {\it A}:") - bmatList := [['text,:start],:bmatList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :matList,:bmatList] - page := htInitPage("F02AJF - All eigenvalues of complex matrix (Black box)",nil) - htSay '"\newline \menuitemstyle{}\tab{2} Enter real values of {\it A}: " - htSay '"\newline \tab{2} " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'f02ajfGen) - htpSetProperty(page,'n,n) --- htpSetProperty(page,'iar,iar) --- htpSetProperty(page,'iai,iai) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -f02ajfDefaultSolve (htPage,iar,iai,ifail) == - n := '4 - page := htInitPage('"F02AJF - All eigenvalues of complex matrix (Black box)",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter real values of {\it A}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 "-21.0" a11 F)) - (bcStrings (6 "0.0" a12 F)) - (bcStrings (6 "13.6" a13 F)) - (bcStrings (6 "0.0" a14 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" a21 F)) - (bcStrings (6 "26.0" a22 F)) - (bcStrings (6 "7.5" a23 F)) - (bcStrings (6 "2.5" a24 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "-2.0" a31 F)) - (bcStrings (6 "1.68" a32 F)) - (bcStrings (6 "4.5" a33 F)) - (bcStrings (6 "1.5" a34 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" a41 F)) - (bcStrings (6 "-2.6" a42 F)) - (bcStrings (6 "-2.7" a43 F)) - (bcStrings (6 "2.5" a44 F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter imaginary values of {\it A}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 "-5.0" b11 F)) - (bcStrings (6 "24.6" b12 F)) - (bcStrings (6 "10.2"b13 F)) - (bcStrings (6 "4.0" b14 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "22.5" b21 F)) - (bcStrings (6 "-5.0" b22 F)) - (bcStrings (6 "-10.0" b23 F)) - (bcStrings (6 "0.0" b24 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "1.5" b31 F)) - (bcStrings (6 "2.24" b32 F)) - (bcStrings (6 "-5.0" b33 F)) - (bcStrings (6 "2.0" b34 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "-2.5" b41 F)) - (bcStrings (6 "0.0" b42 F)) - (bcStrings (6 "3.6" b43 F)) - (bcStrings (6 "-5.0" b44 F))) - htMakeDoneButton('"Continue",'f02ajfGen) - htpSetProperty(page,'n,n) --- htpSetProperty(page,'iar,iar) --- htpSetProperty(page,'iai,iai) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f02ajfGen htPage == - n := htpProperty(htPage,'n) --- iar := htpProperty(htPage,'iar) --- iai := htpProperty(htPage,'iai) - iar := n - iai := n - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - y := REVERSE y - for i in 1..iar repeat - for j in 1..n repeat - elm := STRCONC((first y).1," ") - rowList := [:rowList,elm] - y := rest y - matform := [:matform,rowList] - rowList := [] - for i in 1..iai repeat - for j in 1..n repeat - elm := STRCONC((first y).1," ") - rowList := [:rowList,elm] - y := rest y - bform := [:bform,rowList] - rowList := [] - matstring := bcwords2liststring [bcwords2liststring x for x in matform] - bstring := bcwords2liststring [bcwords2liststring x for x in bform] - prefix := STRCONC('"f02ajf(",STRINGIMAGE n,", ",STRINGIMAGE iar,", ") - prefix := STRCONC(prefix,STRINGIMAGE iai,", ",matstring,", ",bstring,", ") - prefix := STRCONC(prefix,STRINGIMAGE ifail,")") - linkGen prefix - -f02akf() == - htInitPage('"F02AKF - All eigenvalues and eigenvectors of complex matrix (Black box)",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXf02akf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02akf| '|NagEigenPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "Calculates all the eigenvalues and eigenvectors of a complex ") - (text . "matrix {\it A} of order {\it n}.") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline Order of matrix A, {\it n}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 4 n PI)) --- (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{} \tab{2} ") --- (text . "\newline First dimension of array containing real parts, ") --- (text . " {\it iar}: \newline \tab{2} ") --- (bcStrings (6 4 iar PI)) --- (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{} \tab{2} ") --- (text . "\newline First dimension of array containing imaginary parts,") --- (text . " {\it iai}: \newline \tab{2} ") --- (bcStrings (6 4 iai F)) --- (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{} \tab{2} \newline ") --- (text . "First dimension of array of real parts of the eigenvectors, ") --- (text . " {\it ivr}: \newline \tab{2} ") --- (bcStrings (6 4 ivr PI)) --- (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{} \tab{2} \newline ") --- (text . "First dimension of array of imaginary parts of the eigenvectors,") --- (text . " {\it ivi}: \newline \tab{2} ") --- (bcStrings (6 4 ivi PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'f02akfSolve) - htShowPage() - -f02akfSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - iar := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iar) --- objValUnwrap htpLabelSpadValue(htPage, 'iar) - iai := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iai) --- objValUnwrap htpLabelSpadValue(htPage, 'iai) - ivr := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ivr) --- objValUnwrap htpLabelSpadValue(htPage, 'ivr) - ivi := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ivi) --- objValUnwrap htpLabelSpadValue(htPage, 'ivi) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - n = '4 => f02akfDefaultSolve(htPage,iar,iai,ivr,ivi,ifail) - matList := - "append"/[f(i,n) for i in 1..iar] where f(i,n) == - labelList := - "append"/[g(i,j) for j in 1..n] where g(i,j) == - anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) - [['bcStrings,[6, "0.0", anam, 'F]]] - prefix := ('"\newline \tab{2} ") - labelList := [['text,:prefix],:labelList] - bmatList := - "append"/[h(k,n) for k in 1..iai] where h(k,n) == - bList := - "append"/[l(k,p) for p in 1..n] where l(k,p) == - bnam := INTERN STRCONC ('"b",STRINGIMAGE k,STRINGIMAGE p) - [['bcStrings,[6, "0.0", bnam, 'F]]] - prefix := ('"\newline \tab{2} ") - bList := [['text,:prefix],:bList] - start := ('"\blankline \menuitemstyle{}\tab{2}Enter imag values of {\it A}:") - bmatList := [['text,:start],:bmatList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :matList,:bmatList] - page := htInitPage("F02AKF - All eigenvalues and eigenvectors of complex matrix (Black box)",nil) - htSay '"\newline \menuitemstyle{}\tab{2} Enter real values of {\it A}: " - htSay '"\newline \tab{2} " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'f02akfGen) - htpSetProperty(page,'n,n) --- htpSetProperty(page,'iar,iar) --- htpSetProperty(page,'iai,iai) --- htpSetProperty(page,'ivr,ivr) --- htpSetProperty(page,'ivi,ivi) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -f02akfDefaultSolve (htPage,iar,iai,ivr,ivi,ifail) == - n := '4 - page := htInitPage('"F02AKF - All eigenvalues and eigenvectors of complex matrix (Black box)",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter real values of {\it A}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 "-21.0" a11 F)) - (bcStrings (6 "0.0" a12 F)) - (bcStrings (6 "13.6" a13 F)) - (bcStrings (6 "0.0" a14 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" a21 F)) - (bcStrings (6 "26.0" a22 F)) - (bcStrings (6 "7.5" a23 F)) - (bcStrings (6 "2.5" a24 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "-2.0" a31 F)) - (bcStrings (6 "1.68" a32 F)) - (bcStrings (6 "4.5" a33 F)) - (bcStrings (6 "1.5" a34 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" a41 F)) - (bcStrings (6 "-2.6" a42 F)) - (bcStrings (6 "-2.7" a43 F)) - (bcStrings (6 "2.5" a44 F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter imaginary values of {\it A}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 "-5.0" b11 F)) - (bcStrings (6 "24.6" b12 F)) - (bcStrings (6 "10.2"b13 F)) - (bcStrings (6 "4.0" b14 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "22.5" b21 F)) - (bcStrings (6 "-5.0" b22 F)) - (bcStrings (6 "-10.0" b23 F)) - (bcStrings (6 "0.0" b24 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "1.5" b31 F)) - (bcStrings (6 "2.24" b32 F)) - (bcStrings (6 "-5.0" b33 F)) - (bcStrings (6 "2.0" b34 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "-2.5" b41 F)) - (bcStrings (6 "0.0" b42 F)) - (bcStrings (6 "3.6" b43 F)) - (bcStrings (6 "-5.0" b44 F))) - htMakeDoneButton('"Continue",'f02akfGen) - htpSetProperty(page,'n,n) --- htpSetProperty(page,'iar,iar) --- htpSetProperty(page,'iai,iai) --- htpSetProperty(page,'ivr,ivr) --- htpSetProperty(page,'ivi,ivi) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f02akfGen htPage == - n := htpProperty(htPage,'n) --- iar := htpProperty(htPage,'iar) --- iai := htpProperty(htPage,'iai) --- ivr := htpProperty(htPage,'ivr) --- ivi := htpProperty(htPage,'ivi) - iar := n - iai := n - ivr := n - ivi := n - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - y := REVERSE y - for i in 1..iar repeat - for j in 1..n repeat - elm := STRCONC((first y).1," ") - rowList := [:rowList,elm] - y := rest y - matform := [:matform,rowList] - rowList := [] - for i in 1..iai repeat - for j in 1..n repeat - elm := STRCONC((first y).1," ") - rowList := [:rowList,elm] - y := rest y - bform := [:bform,rowList] - rowList := [] - matstring := bcwords2liststring [bcwords2liststring x for x in matform] - bstring := bcwords2liststring [bcwords2liststring x for x in bform] - prefix := STRCONC('"f02akf(",STRINGIMAGE iar,", ",STRINGIMAGE iai,", ") - prefix := STRCONC(prefix,STRINGIMAGE n,", ",STRINGIMAGE ivr,", ") - prefix := STRCONC(prefix,STRINGIMAGE ivi,", ",matstring,", ",bstring,", ") - prefix := STRCONC(prefix,STRINGIMAGE ifail,")") - linkGen prefix - -f02awf() == - htInitPage('"F02AWF - All eigenvalues of complex Hermitian matrix (Black box)",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXf02awf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02awf| '|NagEigenPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\blankline ") - (text . "Calculates all the eigenvalues of a complex Hermitian matrix ") - (text . "{\it A} of order {\it n}.") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline Order of the complex Hermitian matrix A, {\it n}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 4 n PI)) --- (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{} \tab{2} ") --- (text . "\newline First dimension of array containing real parts, ") --- (text . " {\it iar}: \newline \tab{2} ") --- (bcStrings (6 4 iar PI)) --- (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{} \tab{2} ") --- (text . "\newline First dimension of array containing imaginary parts,") --- (text . " {\it iai}: \newline \tab{2} ") --- (bcStrings (6 4 iai F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'f02awfSolve) - htShowPage() - -f02awfSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - iar := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iar) --- objValUnwrap htpLabelSpadValue(htPage, 'iar) - iai := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iai) --- objValUnwrap htpLabelSpadValue(htPage, 'iai) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - n = '4 => f02awfDefaultSolve(htPage,iar,iai,ifail) - matList := - "append"/[f(i,n) for i in 1..iar] where f(i,n) == - labelList := - "append"/[g(i,j) for j in 1..n] where g(i,j) == - anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) - [['bcStrings,[6, "0.0", anam, 'F]]] - prefix := ('"\newline \tab{2} ") - labelList := [['text,:prefix],:labelList] - bmatList := - "append"/[h(k,n) for k in 1..iai] where h(k,n) == - bList := - "append"/[l(k,p) for p in 1..n] where l(k,p) == - bnam := INTERN STRCONC ('"b",STRINGIMAGE k,STRINGIMAGE p) - [['bcStrings,[6, "0.0", bnam, 'F]]] - prefix := ('"\newline \tab{2} ") - bList := [['text,:prefix],:bList] - start := ('"\blankline \menuitemstyle{}\tab{2}Enter imaginary values {\it AI}:") - bmatList := [['text,:start],:bmatList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :matList,:bmatList] - page := htInitPage("F02AWF - All eigenvalues of complex Hermitian matrix (Black box)",nil) - htSay '"\newline \menuitemstyle{}\tab{2} Enter real values of {\it AR}: " - htSay '"\newline \tab{2} " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'f02awfGen) - htpSetProperty(page,'n,n) --- htpSetProperty(page,'iar,iar) --- htpSetProperty(page,'iai,iai) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -f02awfDefaultSolve (htPage,iar,iai,ifail) == - n := '4 - page := htInitPage('"F02AWF - All eigenvalues of complex Hermitian matrix (Black box)",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter real values {\it AR}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 "0.5" a11 F)) - (bcStrings (6 "0.0" a12 F)) - (bcStrings (6 "1.84" a13 F)) - (bcStrings (6 "2.08" a14 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" a21 F)) - (bcStrings (6 "0.5" a22 F)) - (bcStrings (6 "1.12" a23 F)) - (bcStrings (6 "-0.56" a24 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "1.84" a31 F)) - (bcStrings (6 "1.12" a32 F)) - (bcStrings (6 "0.5" a33 F)) - (bcStrings (6 "0.0" a34 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "2.08" a41 F)) - (bcStrings (6 "-0.56" a42 F)) - (bcStrings (6 "0.0" a43 F)) - (bcStrings (6 "0.5" a44 F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter imaginary values {\it AI}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" b11 F)) - (bcStrings (6 "0.0" b12 F)) - (bcStrings (6 "1.38" b13 F)) - (bcStrings (6 "-1.56" b14 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" b21 F)) - (bcStrings (6 "0.0" b22 F)) - (bcStrings (6 "0.84" b23 F)) - (bcStrings (6 "0.42" b24 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "-1.38" b31 F)) - (bcStrings (6 "-0.84" b32 F)) - (bcStrings (6 "0.0" b33 F)) - (bcStrings (6 "0.0" b34 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "1.56" b41 F)) - (bcStrings (6 "-0.42" b42 F)) - (bcStrings (6 "0.0" b43 F)) - (bcStrings (6 "0.0" b44 F))) - htMakeDoneButton('"Continue",'f02awfGen) - htpSetProperty(page,'n,n) --- htpSetProperty(page,'iar,iar) --- htpSetProperty(page,'iai,iai) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f02awfGen htPage == - n := htpProperty(htPage,'n) --- iar := htpProperty(htPage,'iar) --- iai := htpProperty(htPage,'iai) - iar := n - iai := n - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - y := REVERSE y - for i in 1..iar repeat - for j in 1..n repeat - elm := STRCONC((first y).1," ") - rowList := [:rowList,elm] - y := rest y - matform := [:matform,rowList] - rowList := [] - for i in 1..iai repeat - for j in 1..n repeat - elm := STRCONC((first y).1," ") - rowList := [:rowList,elm] - y := rest y - bform := [:bform,rowList] - rowList := [] - matstring := bcwords2liststring [bcwords2liststring x for x in matform] - bstring := bcwords2liststring [bcwords2liststring x for x in bform] - prefix := STRCONC('"f02awf(",STRINGIMAGE n,", ",STRINGIMAGE iar,", ") - prefix := STRCONC(prefix,STRINGIMAGE iai,", ",matstring,", ",bstring,", ") - prefix := STRCONC(prefix,STRINGIMAGE ifail,")") - linkGen prefix - -f02axf() == - htInitPage('"F02AXF - All eigenvalues and eigenvectors of complex Hermitian matrix (Black box)",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXf02axf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02axf| '|NagEigenPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "Calculates all the eigenvalues and eigenvectors of a complex ") - (text . "Hermitian matrix {\it A} of order {\it n}.") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline Order of matrix A, {\it n}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 4 n PI)) --- (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{} \tab{2} ") --- (text . "\newline First dimension of array containing real parts, ") --- (text . " {\it iar}: \newline \tab{2} ") --- (bcStrings (6 4 iar PI)) --- (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{} \tab{2} ") --- (text . "\newline First dimension of array containing imaginary parts,") --- (text . " {\it iai}: \newline \tab{2} ") --- (bcStrings (6 4 iai F)) --- (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{} \tab{2} \newline ") --- (text . "First dimension of array of real parts of the eigenvectors, ") --- (text . " {\it ivr}: \newline \tab{2} ") --- (bcStrings (6 4 ivr PI)) --- (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{} \tab{2} \newline ") --- (text . "First dimension of array of imaginary parts of the eigenvectors,") --- (text . " {\it ivi}: \newline \tab{2} ") --- (bcStrings (6 4 ivi PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'f02axfSolve) - htShowPage() - -f02axfSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - iar := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iar) --- objValUnwrap htpLabelSpadValue(htPage, 'iar) - iai := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iai) --- objValUnwrap htpLabelSpadValue(htPage, 'iai) - ivr := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ivr) --- objValUnwrap htpLabelSpadValue(htPage, 'ivr) - ivi := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ivi) --- objValUnwrap htpLabelSpadValue(htPage, 'ivi) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - n = '4 => f02axfDefaultSolve(htPage,iar,iai,ivr,ivi,ifail) - matList := - "append"/[f(i,n) for i in 1..iar] where f(i,n) == - labelList := - "append"/[g(i,j) for j in 1..n] where g(i,j) == - anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) - [['bcStrings,[6, "0.0", anam, 'F]]] - prefix := ('"\newline \tab{2} ") - labelList := [['text,:prefix],:labelList] - bmatList := - "append"/[h(k,n) for k in 1..iai] where h(k,n) == - bList := - "append"/[l(k,p) for p in 1..n] where l(k,p) == - bnam := INTERN STRCONC ('"b",STRINGIMAGE k,STRINGIMAGE p) - [['bcStrings,[6, "0.0", bnam, 'F]]] - prefix := ('"\newline \tab{2} ") - bList := [['text,:prefix],:bList] - start := ('"\blankline \menuitemstyle{}\tab{2}Enter imaginary values of {\it A}:") - bmatList := [['text,:start],:bmatList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :matList,:bmatList] - page := htInitPage("F02AXF - All eigenvalues and eigenvectors of complex Hermitian matrix (Black box)",nil) - htSay '"\newline \menuitemstyle{}\tab{2} Enter real values of {\it A}: " - htSay '"\newline \tab{2} " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'f02axfGen) - htpSetProperty(page,'n,n) --- htpSetProperty(page,'iar,iar) --- htpSetProperty(page,'iai,iai) --- htpSetProperty(page,'ivr,ivr) --- htpSetProperty(page,'ivi,ivi) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -f02axfDefaultSolve (htPage,iar,iai,ivr,ivi,ifail) == - n := '4 - page := htInitPage('"F02AXF - All eigenvalues and eigenvectors of complex Hermitian matrix (Black box)",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter real values of {\it A}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 "0.5" a11 F)) - (bcStrings (6 "0.0" a12 F)) - (bcStrings (6 "1.84" a13 F)) - (bcStrings (6 "2.08" a14 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" a21 F)) - (bcStrings (6 "0.5" a22 F)) - (bcStrings (6 "1.12" a23 F)) - (bcStrings (6 "-0.56" a24 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "1.84" a31 F)) - (bcStrings (6 "1.12" a32 F)) - (bcStrings (6 "0.5" a33 F)) - (bcStrings (6 "0.0" a34 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "2.08" a41 F)) - (bcStrings (6 "-0.56" a42 F)) - (bcStrings (6 "0.0" a43 F)) - (bcStrings (6 "0.5" a44 F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter imaginary values of {\it A}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" b11 F)) - (bcStrings (6 "0.0" b12 F)) - (bcStrings (6 "1.38" b13 F)) - (bcStrings (6 "-1.56" b14 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" b21 F)) - (bcStrings (6 "0.0" b22 F)) - (bcStrings (6 "0.84" b23 F)) - (bcStrings (6 "0.42" b24 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "-1.38" b31 F)) - (bcStrings (6 "-0.84" b32 F)) - (bcStrings (6 "0.0" b33 F)) - (bcStrings (6 "0.0" b34 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "1.56" b41 F)) - (bcStrings (6 "-0.42" b42 F)) - (bcStrings (6 "0.0" b43 F)) - (bcStrings (6 "0.0" b44 F))) - htMakeDoneButton('"Continue",'f02axfGen) - htpSetProperty(page,'n,n) --- htpSetProperty(page,'iar,iar) --- htpSetProperty(page,'iai,iai) --- htpSetProperty(page,'ivr,ivr) --- htpSetProperty(page,'ivi,ivi) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f02axfGen htPage == - n := htpProperty(htPage,'n) --- iar := htpProperty(htPage,'iar) --- iai := htpProperty(htPage,'iai) --- ivr := htpProperty(htPage,'ivr) --- ivi := htpProperty(htPage,'ivi) - iar := n - iai := n - ivr := n - ivi := n - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - y := REVERSE y - for i in 1..iar repeat - for j in 1..n repeat - elm := STRCONC((first y).1," ") - rowList := [:rowList,elm] - y := rest y - matform := [:matform,rowList] - rowList := [] - for i in 1..iai repeat - for j in 1..n repeat - elm := STRCONC((first y).1," ") - rowList := [:rowList,elm] - y := rest y - bform := [:bform,rowList] - rowList := [] - matstring := bcwords2liststring [bcwords2liststring x for x in matform] - bstring := bcwords2liststring [bcwords2liststring x for x in bform] - prefix := STRCONC('"f02axf(",matstring,", ",STRINGIMAGE iar,", ",bstring) - prefix := STRCONC(prefix,", ",STRINGIMAGE iai,", ",STRINGIMAGE n,", ") - prefix := STRCONC(prefix,STRINGIMAGE ivr,", ",STRINGIMAGE ivi,", ") - prefix := STRCONC(prefix,STRINGIMAGE ifail,")") - linkGen prefix - -f02bbf() == - htInitPage('"F02BBF - Selected eigenvalues and eigenvectors of real symmetric matrix (Black box)",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXf02bbf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02bbf| '|NagEigenPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "Calculates selected eigenvalues and eigenvectors of a real ") - (text . "symmetric matrix {\it A} of order {\it n} by reduction to ") - (text . "tridiagonal form, bisection and inverse iteration, where the ") - (text . "selected eigenvalues lie within a given interval [{\it l,u}].") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline Order of matrix A, {\it n}: ") - (text . "\tab{32} \menuitemstyle{} \tab{34} ") - (text . "Max number of eigenvectors, {\it m}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 4 n PI)) - (text . "\tab{34} ") - (bcStrings (6 3 m PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline Lower end-point of interval {\it l}: ") - (text . "\tab{32} \menuitemstyle{} \tab{34} ") - (text . "Upper end-point of interval {\it u}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 "-2.0" alb F)) - (text . "\tab{34} ") - (bcStrings (6 "3.0" ub F)) --- (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{} \tab{2} ") --- (text . "\newline First dimension of A, {\it ia} ") --- (text . "\inputbitmap{\htbmdir{}/great=.bitmap} n: ") --- (text . "\tab{32} \menuitemstyle{} \tab{34} ") --- (text . "First dimension of V, {\it v} ") --- (text . "\inputbitmap{\htbmdir{}/great=.bitmap} n: ") --- (text . "\newline \tab{2} ") --- (bcStrings (6 4 ia PI)) --- (text . "\tab{34} ") --- (bcStrings (6 4 iv PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'f02bbfSolve) - htShowPage() - -f02bbfSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - m := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) - objValUnwrap htpLabelSpadValue(htPage, 'm) - alb := htpLabelInputString(htPage,'alb) - ub := htpLabelInputString(htPage,'ub) - ia := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ia) --- objValUnwrap htpLabelSpadValue(htPage, 'ia) - iv := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iv) --- objValUnwrap htpLabelSpadValue(htPage, 'iv) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - n = '4 => f02bbfDefaultSolve(htPage,m,alb,ub,ia,iv,ifail) - matList := - "append"/[f(i,n) for i in 1..ia] where f(i,n) == - labelList := - "append"/[g(i,j) for j in 1..n] where g(i,j) == - anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) - [['bcStrings,[6, "0.0", anam, 'F]]] - prefix := ('"\newline \tab{2} ") - labelList := [['text,:prefix],:labelList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :matList] - page := htInitPage('"F02BBF - Selected eigenvalues and eigenvectors of real symmetric matrix (Black box)",nil) - htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " - htSay '"\newline \tab{2} " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'f02bbfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) - htpSetProperty(page,'alb,alb) - htpSetProperty(page,'ub,ub) --- htpSetProperty(page,'ia,ia) --- htpSetProperty(page,'iv,iv) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -f02bbfDefaultSolve (htPage,m,alb,ub,ia,iv,ifail) == - n := '4 - page := htInitPage('"F02BBF - Selected eigenvalues and eigenvectors of real symmetric matrix (Black box)",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 "0.5" a11 F)) - (bcStrings (6 "0.0" a12 F)) - (bcStrings (6 "2.3" a13 F)) - (bcStrings (6 "-2.6" a14 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" a21 F)) - (bcStrings (6 "0.5" a22 F)) - (bcStrings (6 "-1.4" a23 F)) - (bcStrings (6 "-0.7" a24 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "2.3" a31 F)) - (bcStrings (6 "-1.4" a32 F)) - (bcStrings (6 "0.5" a33 F)) - (bcStrings (6 "0.0" a34 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "-2.6" a41 F)) - (bcStrings (6 "-0.7" a42 F)) - (bcStrings (6 "0.0" a43 F)) - (bcStrings (6 "0.5" a44 F))) - htMakeDoneButton('"Continue",'f02bbfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) - htpSetProperty(page,'alb,alb) - htpSetProperty(page,'ub,ub) --- htpSetProperty(page,'ia,ia) --- htpSetProperty(page,'iv,iv) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f02bbfGen htPage == - n := htpProperty(htPage,'n) - m := htpProperty(htPage,'m) - alb := htpProperty(htPage,'alb) - ub := htpProperty(htPage,'ub) - -- ia should be = n, unlike the example program - -- where ia = nmax --- ia := htpProperty(htPage,'ia) --- iv := htpProperty(htPage,'iv) - ia := n - iv := n - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - y := REVERSE y - for i in 1..ia repeat - for j in 1..n repeat - elm := STRCONC((first y).1," ") - rowList := [:rowList,elm] - y := rest y - matform := [:matform,rowList] - rowList := [] - matstring := bcwords2liststring [bcwords2liststring x for x in matform] - prefix := STRCONC('"f02bbf(",STRINGIMAGE ia,", ",STRINGIMAGE n,", ") - prefix := STRCONC(prefix,alb,", ",ub,", ",STRINGIMAGE m,", ",STRINGIMAGE iv) - prefix := STRCONC(prefix,", ",matstring,", ",STRINGIMAGE ifail,")") - linkGen prefix - -f02bjf() == - htInitPage('"F02BJF - All eigenvalues and optionally eigenvectors of generalized eigenproblem by {\it QZ} algorithm, real matrices (Black box)",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXf02bjf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02bjf| '|NagEigenPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "Calculates all the eigenvalues and, if required, all the ") - (text . "eigenvectors of Ax = \lambda Bx, where A and B are real ") - (text . "symmetric matrices of order n and B using the QZ algorithm. ") - (text . "The routine does not actually produce the eigenvalues ") - (text . "\inputbitmap{\htbmdir{}/lamdaj.bitmap}, but instead returns ") - (text . "\inputbitmap{\htbmdir{}/alphaj.bitmap} and ") - (text . "\inputbitmap{\htbmdir{}/betaj.bitmap} ") - (text . "such that \inputbitmap{\htbmdir{}/lamdaj.bitmap} = ") - (text . "\inputbitmap{\htbmdir{}/alphaj.bitmap} / ") - (text . "\inputbitmap{\htbmdir{}/betaj.bitmap}, ") - (text . "for j = 1,2,...,n. ") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline Order of matrices A and B, {\it n}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 4 n PI)) --- (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{} \tab{2} ") --- (text . "\newline First dimension of A, {\it ia}: ") --- (text . "\tab{32} \menuitemstyle{} \tab{34} ") --- (text . "\newline First dimension of B, {\it ib}: ") --- (text . "\newline \tab{2} ") --- (bcStrings (6 4 ia PI)) --- (text . "\tab{34} ") --- (bcStrings (6 4 ib F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") --- (text . "\newline First dimension of V, {\it iv}: ") --- (text . "\tab{32} \menuitemstyle{} \tab{34} ") - (text . "\newline Tolerance, {\it eps}: ") - (text . "\newline \tab{2} ") --- (bcStrings (6 4 iv PI)) --- (text . "\tab{34} ") - (bcStrings (6 "1.0e-4" eps F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Are eigenvectors required: ") - (radioButtons matv - ("" " true" true) - ("" " false" false)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'f02bjfSolve) - htShowPage() - -f02bjfSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - ia := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ia) --- objValUnwrap htpLabelSpadValue(htPage, 'ia) - ib := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ib) --- objValUnwrap htpLabelSpadValue(htPage, 'ib) - iv := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iv) --- objValUnwrap htpLabelSpadValue(htPage, 'iv) - eps := htpLabelInputString(htPage,'eps) - bool := htpButtonValue(htPage,'matv) - matv := - bool = 'true => '"true" - '"false" - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - n = '4 => f02bjfDefaultSolve(htPage,ia,ib,iv,eps,matv,ifail) - matList := - "append"/[f(i,n) for i in 1..ia] where f(i,n) == - labelList := - "append"/[g(i,j) for j in 1..n] where g(i,j) == - anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) - [['bcStrings,[6, "0.0", anam, 'F]]] - prefix := ('"\newline \tab{2} ") - labelList := [['text,:prefix],:labelList] - bmatList := - "append"/[h(k,n) for k in 1..ib] where h(k,n) == - bList := - "append"/[l(k,p) for p in 1..n] where l(k,p) == - bnam := INTERN STRCONC ('"b",STRINGIMAGE k,STRINGIMAGE p) - [['bcStrings,[6, "0.0", bnam, 'F]]] - prefix := ('"\newline \tab{2} ") - bList := [['text,:prefix],:bList] - start := ('"\blankline \menuitemstyle{} \tab{2} Enter values of {\it b}:") - bmatList := [['text,:start],:bmatList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :matList,:bmatList] - page := htInitPage('"F02BJF - All eigenvalues and optionally eigenvectors of generalized eigenproblem by {\it QZ} algorithm, real matrices (Black box)",nil) - htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " - htSay '"\newline \tab{2} " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'f02bjfGen) - htpSetProperty(page,'n,n) --- htpSetProperty(page,'ia,ia) --- htpSetProperty(page,'ib,ib) --- htpSetProperty(page,'iv,iv) - htpSetProperty(page,'eps,eps) - htpSetProperty(page,'matv,matv) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -f02bjfDefaultSolve (htPage,ia,ib,iv,eps,matv,ifail) == - n := '4 - page := htInitPage('"F02BJF - All eigenvalues and optionally eigenvectors of generalized eigenproblem by {\it QZ} algorithm, real matrices (Black box)",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 "3.9" a11 F)) - (bcStrings (6 "12.5" a12 F)) - (bcStrings (6 "-34.5" a13 F)) - (bcStrings (6 "-0.5" a14 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "4.3" a21 F)) - (bcStrings (6 "21.5" a22 F)) - (bcStrings (6 "-47.5" a23 F)) - (bcStrings (6 "7.5" a24 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "4.3" a31 F)) - (bcStrings (6 "21.5" a32 F)) - (bcStrings (6 "-43.5" a33 F)) - (bcStrings (6 "3.5" a34 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "4.4" a41 F)) - (bcStrings (6 "26.0" a42 F)) - (bcStrings (6 "-46.0" a43 F)) - (bcStrings (6 "6.0" a44 F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter values of {\it B}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 1 b11 F)) - (bcStrings (6 2 b12 F)) - (bcStrings (6 "-3" b13 F)) - (bcStrings (6 1 b14 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 1 b21 F)) - (bcStrings (6 3 b22 F)) - (bcStrings (6 "-5" b23 F)) - (bcStrings (6 4b24 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 1 b31 F)) - (bcStrings (6 3 b32 F)) - (bcStrings (6 -4 b33 F)) - (bcStrings (6 3 b34 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 1 b41 F)) - (bcStrings (6 3 b42 F)) - (bcStrings (6 -4 b43 F)) - (bcStrings (6 4 b44 F))) - htMakeDoneButton('"Continue",'f02bjfGen) - htpSetProperty(page,'n,n) --- htpSetProperty(page,'ia,ia) --- htpSetProperty(page,'ib,ib) --- htpSetProperty(page,'iv,iv) - htpSetProperty(page,'eps,eps) - htpSetProperty(page,'matv,matv) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f02bjfGen htPage == - n := htpProperty(htPage,'n) --- ia := htpProperty(htPage,'ia) --- ib := htpProperty(htPage,'ib) --- iv := htpProperty(htPage,'iv) - ia := n - ib := n - iv := n - eps := htpProperty(htPage,'eps) - matv := htpProperty(htPage,'matv) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - y := REVERSE y - for i in 1..ia repeat - for j in 1..n repeat - elm := STRCONC((first y).1," ") - rowList := [:rowList,elm] - y := rest y - matform := [:matform,rowList] - rowList := [] - for i in 1..ib repeat - for j in 1..n repeat - elm := STRCONC((first y).1," ") - rowList := [:rowList,elm] - y := rest y - bform := [:bform,rowList] - rowList := [] - matstring := bcwords2liststring [bcwords2liststring x for x in matform] - bstring := bcwords2liststring [bcwords2liststring x for x in bform] - prefix := STRCONC('"f02bjf(",STRINGIMAGE n,", ",STRINGIMAGE ia,", ") - prefix := STRCONC(prefix,STRINGIMAGE ib,", ",eps,", ",matv,", ") - prefix := STRCONC(prefix,STRINGIMAGE iv,", ",matstring,", ",bstring,", ") - prefix := STRCONC(prefix,STRINGIMAGE ifail,")") - linkGen prefix - - -f02fjf() == - htInitPage('"F02FJF - Selected eigenvalues and eigenvectors of sparse symmetric eigenproblem",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXf02fjf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02fjf| '|NagEigenPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "Finds the {\it m} eigenvalues of largest absolute value and the ") - (text . "corresponding eigenvectors for the eigenvalue problem ") - (text . "{\it Cx = \htbitmap{lambda}x}, where {\it C} is a real matrix ") - (text . "of order {\it n} such that {\it BC = \htbitmap{ctb}} for a ") - (text . "given positive-definite matrix {\it B}. ") - (text . "\blankline ") - (text . "\newline ") - (text . "Read the input file to see the example program. ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "\spadcommand{)read f02fjf \bound{s0}} ")) - htShowPage() - - -f02wef() == - htInitPage('"F02WEF - SVD of real matrix",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXf02wef} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02wef| '|NagEigenPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "Returns all or part of the singular value decomposition of a ") - (text . "real {\it m} by {\it n} matrix {\it A}.") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline Rows of matrix A, {\it m}: ") - (text . "\tab{32} \menuitemstyle{} \tab{34} ") - (text . "Columns of matrix A, {\it n}: \newline \tab{2} ") - (bcStrings (6 5 m PI)) - (text . "\tab{34} ") - (bcStrings (6 3 n PI)) - (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{} \tab{2} ") --- (text . "\newline First dimension of A, {\it lda}: ") --- (text . "\tab{32} \menuitemstyle{} \tab{34} ") --- (text . "First dimension of B, {\it ldb}: ") --- (text . "\newline \tab{2} ") --- (bcStrings (6 5 lda PI)) --- (text . "\tab{34} ") --- (bcStrings (6 5 ldb PI)) --- (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Number of columns of matrix B, {\it ncolb}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 1 ncolb PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Is the matrix {\it Q} required, {\it wantq}:") - (radioButtons wantq - (" " " true" qtrue) - (" " " false" qfalse)) - (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{} \tab{2} ") --- (text . "\newline First dimension of {\it Q}, {\it ldq}: ") --- (text . "\tab{32} \menuitemstyle{} \tab{34} ") --- (text . "First dimension of {\it PT}, {\it ldpt}: ") --- (text . "\newline \tab{2} ") --- (bcStrings (6 1 ldq PI)) --- (text . "\tab{34} ") --- (bcStrings (6 5 ldpt PI)) --- (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Is the matrix {\it PT} required, {\it wantp}:") - (radioButtons wantp - (" " " true" ptrue) - (" " " false" pfalse)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'f02wefSolve) - htShowPage() - -f02wefSolve htPage == - m := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) - objValUnwrap htpLabelSpadValue(htPage, 'm) - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - lda := m --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lda) --- objValUnwrap htpLabelSpadValue(htPage, 'lda) - ldb := m --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ldb) --- objValUnwrap htpLabelSpadValue(htPage, 'ldb) - ncolb := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ncolb) - objValUnwrap htpLabelSpadValue(htPage, 'ncolb) - operation := htpButtonValue(htPage,'wantq) - wantq := - operation = 'qtrue => '"true" - '"false" - ldq := m --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ldq) --- objValUnwrap htpLabelSpadValue(htPage, 'ldq) - ldpt := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ldpt) --- objValUnwrap htpLabelSpadValue(htPage, 'ldpt) - elements := htpButtonValue(htPage,'wantp) - wantp := - elements = 'ptrue => '"true" - '"false" - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - ((m = '5 and n = '3) and ncolb = '1) => - f02wefDefaultSolve(htPage,lda,ldb,wantq,ldq,ldpt,wantp,ifail) - matList := - "append"/[fa(i,n) for i in 1..lda] where fa(i,n) == - labelList := - "append"/[ga(i,j) for j in 1..n] where ga(i,j) == - anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) - [['bcStrings,[10, "0.0", anam, 'F]]] - prefix := ('"\newline \tab{2} ") - labelList := [['text,:prefix],:labelList] - bList := - "append"/[fb(i,ncolb) for i in 1..ldb] where fb(i,ncolb) == - pre := ("\newline \tab{2} ") - labelList := - "append"/[gb(i,j) for j in 1..ncolb] where gb(i,j) == - bnam := INTERN STRCONC ('"b",STRINGIMAGE i, STRINGIMAGE j) - [['bcStrings,[6, "0.0", bnam, 'F]]] - labelList := [['text,:pre],:labelList] - prefix := ("\blankline \menuitemstyle{}\tab{2} Enter values of {\it B}: ") - bList := [['text,:prefix],:bList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :matList,:bList] - page := htInitPage('"F02WEF - SVD of real matrix",nil) - htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " - htSay '"\newline \tab{2} " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'f02wefGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) --- htpSetProperty(page,'lda,lda) --- htpSetProperty(page,'ldb,ldb) - htpSetProperty(page,'ncolb,ncolb) - htpSetProperty(page,'wantq,wantq) --- htpSetProperty(page,'ldq,ldq) --- htpSetProperty(page,'ldpt,ldpt) - htpSetProperty(page,'wantp,wantp) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f02wefDefaultSolve(htPage,lda,ldb,wantq,ldq,ldpt,wantp,ifail) == - n := '3 - m := '5 - ncolb := '1 - page := htInitPage('"F02WEF - SVD of real matrix",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 "2.0" a11 F)) - (bcStrings (6 "2.5" a12 F)) - (bcStrings (6 "2.5" a13 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "2.0" a21 F)) - (bcStrings (6 "2.5" a22 F)) - (bcStrings (6 "2.5" a23 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "1.6" a31 F)) - (bcStrings (6 "-0.4" a32 F)) - (bcStrings (6 "2.8" a33 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "2.0" a41 F)) - (bcStrings (6 "-0.5" a42 F)) - (bcStrings (6 "0.5" a43 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "1.2" a51 F)) - (bcStrings (6 "-0.3" a52 F)) - (bcStrings (6 "-2.9" a53 F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} Enter values of {\it B}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 "1.1" b11 F)) - (bcStrings (6 "0.9" b12 F)) - (bcStrings (6 "0.6" b13 F)) - (bcStrings (6 "0.0" b14 F)) - (bcStrings (6 "-0.8" b15 F)) - (text . "\blankline ")) - htMakeDoneButton('"Continue",'f02wefGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) - htpSetProperty(page,'lda,lda) - htpSetProperty(page,'ldb,ldb) - htpSetProperty(page,'ncolb,ncolb) - htpSetProperty(page,'wantq,wantq) - htpSetProperty(page,'ldq,ldq) - htpSetProperty(page,'ldpt,ldpt) - htpSetProperty(page,'wantp,wantp) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f02wefGen htPage == - n := htpProperty(htPage,'n) - m := htpProperty(htPage,'m) - lda := htpProperty(htPage,'lda) - ldb := htpProperty(htPage,'ldb) - ncolb := htpProperty(htPage,'ncolb) - wantq := htpProperty(htPage,'wantq) - ldq := htpProperty(htPage,'ldq) - ldpt := htpProperty(htPage,'ldpt) - wantp := htpProperty(htPage,'wantp) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - y := REVERSE y - for i in 1..lda repeat - for j in 1..n repeat - elm := STRCONC((first y).1," ") - rowList := [:rowList,elm] - y := rest y - matform := [:matform,rowList] - rowList := [] - matstring := bcwords2liststring [bcwords2liststring x for x in matform] - for i in 1..ldb repeat - for j in 1..ncolb repeat - elm := STRCONC((first y).1," ") - rowList := [:rowList,elm] - y := rest y - bform := [:bform,rowList] - rowList := [] - bstring := bcwords2liststring [bcwords2liststring x for x in bform] - prefix := STRCONC('"f02wef(",STRINGIMAGE m,",",STRINGIMAGE n,",") - prefix := STRCONC(prefix,STRINGIMAGE lda,", ",STRINGIMAGE ncolb,", ") - prefix := STRCONC(prefix,STRINGIMAGE ldb,", ",wantq,", ") - prefix := STRCONC(prefix,STRINGIMAGE ldq,", ",wantp,", ") - prefix := STRCONC(prefix,STRINGIMAGE ldpt,", ",matstring,", ",bstring," ,") - linkGen STRCONC(prefix,STRINGIMAGE ifail,")") - -f02xef() == - htInitPage('"F02XEF - SVD of complex matrix",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXf02xef} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02xef| '|NagEigenPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "Returns all or part of the singular value decomposition of a ") - (text . "complex {\it m} by {\it n} matrix {\it A}.") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline Rows of matrix A, {\it m}: ") - (text . "\tab{32} \menuitemstyle{} \tab{34} ") - (text . "Columns of matrix A, {\it n}: \newline \tab{2} ") - (bcStrings (6 5 m PI)) - (text . "\tab{34} ") - (bcStrings (6 3 n PI)) - (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{} \tab{2} ") --- (text . "\newline First dimension of A, {\it lda}: ") --- (text . "\tab{32} \menuitemstyle{} \tab{34} ") --- (text . "First dimension of B, {\it ldb}: ") --- (text . "\newline \tab{2} ") --- (bcStrings (6 5 lda PI)) --- (text . "\tab{34} ") --- (bcStrings (6 5 ldb PI)) --- (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Number of columns of matrix B, {\it ncolb}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 1 ncolb PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Is the matrix {\it Q} required, {\it wantq}:") - (radioButtons wantq - (" " " true" qtrue) - (" " " false" qfalse)) - (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{} \tab{2} ") --- (text . "\newline First dimension of {\it Q}, {\it ldq}: ") --- (text . "\tab{32} \menuitemstyle{} \tab{34} ") --- (text . "First dimension of {\it PH}, {\it ldph}: ") --- (text . "\newline \tab{2} ") --- (bcStrings (6 5 ldq PI)) --- (text . "\tab{34} ") --- (bcStrings (6 3 ldph PI)) --- (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Is the matrix {\it PH} required, {\it wantp}:") - (radioButtons wantp - (" " " true" ptrue) - (" " " false" pfalse)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'f02xefSolve) - htShowPage() - -f02xefSolve htPage == - m := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) - objValUnwrap htpLabelSpadValue(htPage, 'm) - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - lda := m --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lda) --- objValUnwrap htpLabelSpadValue(htPage, 'lda) - ldb := m --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ldb) --- objValUnwrap htpLabelSpadValue(htPage, 'ldb) - ncolb := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ncolb) - objValUnwrap htpLabelSpadValue(htPage, 'ncolb) - operation := htpButtonValue(htPage,'wantq) - wantq := - operation = 'qtrue => '"true" - '"false" - ldq := m --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ldq) --- objValUnwrap htpLabelSpadValue(htPage, 'ldq) - ldph := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ldph) --- objValUnwrap htpLabelSpadValue(htPage, 'ldph) - elements := htpButtonValue(htPage,'wantp) - wantp := - elements = 'ptrue => '"true" - '"false" - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - ((m = '5 and n = '3) and ncolb = '1) => - f02xefDefaultSolve(htPage,lda,ldb,wantq,ldq,ldph,wantp,ifail) - matList := - "append"/[fa(i,n) for i in 1..lda] where fa(i,n) == - labelList := - "append"/[ga(i,j) for j in 1..n] where ga(i,j) == - anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) - [['bcStrings,[15, "0.0", anam, 'F]]] - prefix := ('"\newline \tab{2} ") - labelList := [['text,:prefix],:labelList] - bList := - "append"/[fb(i,ncolb) for i in 1..ldb] where fb(i,ncolb) == - pre := ("\newline \tab{2} ") - labelList := - "append"/[gb(i,j) for j in 1..ncolb] where gb(i,j) == - bnam := INTERN STRCONC ('"b",STRINGIMAGE i, STRINGIMAGE j) - [['bcStrings,[15, "0.0", bnam, 'F]]] - labelList := [['text,:pre],:labelList] - prefix := ("\blankline \menuitemstyle{}\tab{2} Enter values of {\it B}: ") - bList := [['text,:prefix],:bList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :matList,:bList] - page := htInitPage('"F02XEF - SVD of complex matrix",nil) - htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " - htSay '"\newline \tab{2} " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'f02xefGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) - htpSetProperty(page,'lda,lda) - htpSetProperty(page,'ldb,ldb) - htpSetProperty(page,'ncolb,ncolb) - htpSetProperty(page,'wantq,wantq) - htpSetProperty(page,'ldq,ldq) - htpSetProperty(page,'ldph,ldph) - htpSetProperty(page,'wantp,wantp) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f02xefDefaultSolve(htPage,lda,ldb,wantq,ldq,ldph,wantp,ifail) == - n := '3 - m := '5 - ncolb := '1 - page := htInitPage('"F02XEF - SVD of complex matrix",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ") - (text . "\newline \tab{2} ") - (bcStrings (15 "0.5*%i" a11 F)) - (bcStrings (15 "-0.5 + 1.5*%i" a12 F)) - (bcStrings (15 "-1 + 1*%i" a13 F)) - (text . "\newline \tab{2} ") - (bcStrings (15 "0.4 + 0.3*%i" a21 F)) - (bcStrings (15 "0.9 + 1.3*%i" a22 F)) - (bcStrings (15 "0.2 + 1.4*%i" a23 F)) - (text . "\newline \tab{2} ") - (bcStrings (15 "0.4" a31 F)) - (bcStrings (15 "-0.4 + 0.4*%i" a32 F)) - (bcStrings (15 "1.8" a33 F)) - (text . "\newline \tab{2} ") - (bcStrings (15 "0.3 - 0.4*%i" a41 F)) - (bcStrings (15 "0.1 + 0.7*%i" a42 F)) - (bcStrings (15 "0.0" a43 F)) - (text . "\newline \tab{2} ") - (bcStrings (15 "-0.3*%i" a51 F)) - (bcStrings (15 "0.3 + 0.3*%i" a52 F)) - (bcStrings (15 "2.4*%i" a53 F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} Enter values of {\it B}: ") - (text . "\newline \tab{2} ") - (bcStrings (15 "-0.55+1.05*%i" b11 F)) - (text . "\newline \tab{2} ") - (bcStrings (15 "0.49+0.93*%i" b12 F)) - (text . "\newline \tab{2} ") - (bcStrings (15 "0.56-0.16*%i" b13 F)) - (text . "\newline \tab{2} ") - (bcStrings (15 "0.39+0.23*%i" b14 F)) - (text . "\newline \tab{2} ") - (bcStrings (15 "1.13+0.83*%i" b15 F)) - (text . "\blankline ")) - htMakeDoneButton('"Continue",'f02xefGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) - htpSetProperty(page,'lda,lda) - htpSetProperty(page,'ldb,ldb) - htpSetProperty(page,'ncolb,ncolb) - htpSetProperty(page,'wantq,wantq) - htpSetProperty(page,'ldq,ldq) - htpSetProperty(page,'ldph,ldph) - htpSetProperty(page,'wantp,wantp) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f02xefGen htPage == - n := htpProperty(htPage,'n) - m := htpProperty(htPage,'m) - lda := htpProperty(htPage,'lda) - ldb := htpProperty(htPage,'ldb) - ncolb := htpProperty(htPage,'ncolb) - wantq := htpProperty(htPage,'wantq) - ldq := htpProperty(htPage,'ldq) - ldph := htpProperty(htPage,'ldph) - wantp := htpProperty(htPage,'wantp) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - y := REVERSE y - for i in 1..lda repeat - for j in 1..n repeat - elm := STRCONC((first y).1," ") - rowList := [:rowList,elm] - y := rest y - matform := [:matform,rowList] - rowList := [] - matstring := bcwords2liststring [bcwords2liststring x for x in matform] - for i in 1..ldb repeat - for j in 1..ncolb repeat - elm := STRCONC((first y).1," ") - rowList := [:rowList,elm] - y := rest y - bform := [:bform,rowList] - rowList := [] - bstring := bcwords2liststring [bcwords2liststring x for x in bform] - prefix := STRCONC('"f02xef(",STRINGIMAGE m,",",STRINGIMAGE n,",") - prefix := STRCONC(prefix,STRINGIMAGE lda,", ",STRINGIMAGE ncolb,", ") - prefix := STRCONC(prefix,STRINGIMAGE ldb,", ",wantq,", ") - prefix := STRCONC(prefix,STRINGIMAGE ldq,", ",wantp,", ") - prefix := STRCONC(prefix,STRINGIMAGE ldph,", ",matstring,", ",bstring," ,") - linkGen STRCONC(prefix,STRINGIMAGE ifail,")") - - -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/nag-f04.boot b/src/interp/nag-f04.boot new file mode 100644 index 00000000..2d50f701 --- /dev/null +++ b/src/interp/nag-f04.boot @@ -0,0 +1,2311 @@ +-- 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. + + +)package "BOOT" + +f04adf() == + htInitPage("F04ADF - Solution of complex simultaneous linear equations, with multiple right-hand sides (Black box)",nil) + htMakePage '( + (domainConditions + (isDomain I (Integer))) + (text . "\windowlink{Manual Page}{manpageXXf04adf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04adf| '|NagLinearEquationSolvingPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\newline ") + (text . "Calculates the approximate solution of a set of complex linear ") + (text . "equations {\it AX = B} using an {\it LU} factorization with ") + (text . "partial pivoting, where {\it A} is an n * n matrix, {\it X} is ") + (text . "an {\it n} by {\it m} matrix of unknowns and {\it B} is an ") + (text . "{\it n} by {\it m} matrix of right-hand sides.") + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} ") + (text . "{\it n} order of matrix A:") + (text . "\tab{28} \menuitemstyle{}\tab{30} ") + (text . "{\it m} number of right-hand sides \htbitmap{great=} 0 :") + (text . "\newline\tab{2} ") + (bcStrings (10 3 n I)) + (text . "\tab{30} ") + (bcStrings (10 1 m I)) +-- (text . "\blankline ") +-- (text . "\newline \menuitemstyle{}\tab{2} ") +-- (text . "{\it IA} first dimension of A:") +-- (text . "\tab{32} \menuitemstyle{}\tab{34} ") +-- (text . "{\it IB} first dimension of B:") +-- (text . "\newline\tab{2} ") +-- (bcStrings (10 3 ia I)) +-- (text . "\tab{34} ") +-- (bcStrings (10 3 ib I)) +-- (text . "\blankline ") +-- (text . "\newline \menuitemstyle{}\tab{2} ") +-- (text . "{\it IC} first dimension of C:") +-- (text . "\newline\tab{2} ") +-- (bcStrings (10 3 ic I)) + (text . "\blankline ") + (text . "\newline \menuitemstyle{} \tab{2} ") + (text . "Ifail value:") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'f04adfSolve) + htShowPage() + +f04adfSolve htPage == + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + m := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) + objValUnwrap htpLabelSpadValue(htPage, 'm) + ia := n +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ia) +-- objValUnwrap htpLabelSpadValue(htPage, 'ia) + ib := n +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ib) +-- objValUnwrap htpLabelSpadValue(htPage, 'ib) + ic := n +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ic) +-- objValUnwrap htpLabelSpadValue(htPage, 'ic) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + (n = '3 and m = '1) => f04adfDefaultSolve(htPage,ifail) + matList := + "append"/[f(i,n) for i in 1..ia] where f(i,n) == + labelList := + "append"/[g(i,j) for j in 1..n] where g(i,j) == + ianam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) + [['bcStrings,[12, "0.0 + 0.0*%i", ianam, 'F]]] + prefix := ('"\newline \tab{2} ") + labelList := [['text,:prefix],:labelList] + bmatList := + "append"/[fb(i,m) for i in 1..ib] where fb(i,m) == + blabelList := + "append"/[gb(i,j) for j in 1..m] where gb(i,j) == + bnam := INTERN STRCONC ('"b",STRINGIMAGE i, STRINGIMAGE j) + [['bcStrings,[12, "0.0 + 0.0*%i", bnam, 'F]]] + prefix := ('"\newline \tab{2} ") + blabelList := [['text,:prefix],:blabelList] + start := ('"\blankline \menuitemstyle{} \tab{2} Enter values of {\it b}:") + bmatList := [['text,:start],:bmatList] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain F (Float))), + :matList,:bmatList] + page := htInitPage("F04ADF - Solution of complex simultaneous linear equations, with multiple right-hand sides (Black box)",nil) + htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " + htSay '"\newline \tab{2} " + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'f04adfGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'m,m) +-- htpSetProperty(page,'ia,ia) +-- htpSetProperty(page,'ib,ib) +-- htpSetProperty(page,'ic,ic) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + + +f04adfDefaultSolve (htPage, ifail) == + n := '3 + m := '1 + ia := '3 + ib := '3 + ic := '3 + page := htInitPage("F04ADF - Solution of complex simultaneous linear equations, with multiple right-hand sides (Black box)",nil) + htMakePage '( + (domainConditions + (isDomain F (Float)) + (isDomain I (Integer))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ") + (text . "\newline \tab{2} ") + (bcStrings (12 "1" a11 F)) + (bcStrings (12 "1 + 2*%i" a12 F)) + (bcStrings (12 "2 + 10*%i" a13 F)) + (text . "\newline \tab{2} ") + (bcStrings (12 "1 + %i" a21 F)) + (bcStrings (12 "3*%i" a22 F)) + (bcStrings (12 "-5 + 14*%i" a23 F)) + (text . "\newline \tab{2} ") + (bcStrings (12 "1 + %i" a31 F)) + (bcStrings (12 "5*%i" a32 F)) + (bcStrings (12 "-8 + 20*%i" a33 F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Enter values of {\it b}: ") + (text . "\newline \tab{2} ") + (bcStrings (12 "1" b1 F)) + (text . "\newline \tab{2} ") + (bcStrings (12 "0" b2 F)) + (text . "\newline \tab{2} ") + (bcStrings (12 "0" b3 F))) + htMakeDoneButton('"Continue",'f04adfGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'m,m) +-- htpSetProperty(page,'ia,ia) +-- htpSetProperty(page,'ib,ib) +-- htpSetProperty(page,'ic,ic) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +f04adfGen htPage == + n := htpProperty(htPage,'n) + m := htpProperty(htPage,'m) +-- ia := htpProperty(htPage,'ia) +-- ib := htpProperty(htPage,'ib) +-- ic := htpProperty(htPage,'ic) + ia := n + ib := n + ic := n + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + -- will probably need to change this as its a vector not an array + for i in 1..m repeat + for j in 1..ib repeat + right := STRCONC((first y).1," ") + y := rest y + bList := [right,:bList] + bstring := bcwords2liststring bList + boutList := [bstring,:boutList] + bList := [] + boutstring := bcwords2liststring boutList + y := REVERSE y + k := -1 + matform := [[y.(k := k + 1).1 for j in 0..(n-1)] for i in 0..(ia-1)] + matstring := bcwords2liststring [bcwords2liststring x for x in matform] + prefix := STRCONC('"f04adf(",STRINGIMAGE ia,",",boutstring,",") + prefix := STRCONC(prefix,STRINGIMAGE ib,", ",STRINGIMAGE n,", ") + prefix := STRCONC(prefix,STRINGIMAGE m,", ",STRINGIMAGE ic) + prefix := STRCONC(prefix,", ",matstring,", ",STRINGIMAGE ifail,")") + bcGen prefix + +f04arf() == + htInitPage("F04ARF - Solution of real simultaneous linear equations, one right-hand side (Black box)",nil) + htMakePage '( + (domainConditions + (isDomain I (Integer))) + (text . "\windowlink{Manual Page}{manpageXXf04arf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04arf| '|NagLinearEquationSolvingPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\blankline ") + (text . "Calculates the approximate solution of a set of real linear ") + (text . "equations {\it Ax = b} using an {\it LU} factorization with ") + (text . "pivoting, where {\it A} is an n * n matrix, {\it x} is an n ") + (text . "element vector of unknowns and {\it b} is an n element ") + (text . "right-hand side vector.") + (text . "\blankline ") + (text . "\newline ") + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} ") +-- (text . "{\it IA} first dimension of A:") +-- (text . "\tab{32} \menuitemstyle{}\tab{34} ") + (text . "{\it n} order of matrix A:") + (text . "\newline\tab{2} ") +-- (bcStrings (10 8 ia I)) +-- (text . "\tab{34} ") + (bcStrings (10 3 n I)) + (text . "\blankline ") + (text . "\newline \menuitemstyle{} \tab{2} ") + (text . "Ifail value:") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'f04arfSolve) + htShowPage() + +f04arfSolve htPage == + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + ia := n +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ia) +-- objValUnwrap htpLabelSpadValue(htPage, 'ia) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + n = '3 => f04arfDefaultSolve(htPage,ifail) + matList := + "append"/[f(i,n) for i in 1..ia] where f(i,n) == + labelList := + "append"/[g(i,j) for j in 1..n] where g(i,j) == + ianam := INTERN STRCONC ('"ia",STRINGIMAGE i, STRINGIMAGE j) + [['bcStrings,[6, "0.0", ianam, 'F]]] + prefix := ('"\newline \tab{2} ") + labelList := [['text,:prefix],:labelList] + bmatList := + "append"/[h(k) for k in 1..n] where h(k) == + prefix := ('"\newline \tab{2} ") + bnam := INTERN STRCONC ('"b",STRINGIMAGE k) + [['text,:prefix],['bcStrings,[6, "0.0", bnam, 'F]]] + start := ('"\blankline \menuitemstyle{} \tab{2} Enter values of {\it b}:") + bmatList := [['text,:start],:bmatList] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain F (Float))), + :matList,:bmatList] + page := htInitPage("F04ARF - Solution of real simultaneous linear equations, one right-hand side (Black box)",nil) + htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " + htSay '"\newline \tab{2} " + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'f04arfGen) + htpSetProperty(page,'n,n) +-- htpSetProperty(page,'ia,ia) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + + +f04arfDefaultSolve (htPage, ifail) == + n := '3 + ia := '3 + page := htInitPage("F04ARF - Solution of real simultaneous linear equations, one right-hand side (Black box)",nil) + htMakePage '( + (domainConditions + (isDomain F (Float)) + (isDomain I (Integer))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ") + (text . "\newline \tab{2} ") + (bcStrings (6 33 ia11 F)) + (bcStrings (6 16 ia12 F)) + (bcStrings (6 72 ia13 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "-24" ia21 F)) + (bcStrings (6 "-10" ia22 F)) + (bcStrings (6 "-57" ia23 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "-8" ia31 F)) + (bcStrings (6 "-4" ia32 F)) + (bcStrings (6 "-17" ia33 F)) +-- (text . "\newline \tab{2} ") +-- (bcStrings (6 0 ia41 F)) +-- (bcStrings (6 0 ia42 F)) +-- (bcStrings (6 0 ia43 F)) +-- (text . "\newline \tab{2} ") +-- (bcStrings (6 0 ia51 F)) +-- (bcStrings (6 0 ia52 F)) +-- (bcStrings (6 0 ia53 F)) +-- (text . "\newline \tab{2} ") +-- (bcStrings (6 0 ia61 F)) +-- (bcStrings (6 0 ia62 F)) +-- (bcStrings (6 0 ia63 F)) +-- (text . "\newline \tab{2} ") +-- (bcStrings (6 0 ia71 F)) +-- (bcStrings (6 0 ia72 F)) +-- (bcStrings (6 0 ia73 F)) +-- (text . "\newline \tab{2} ") +-- (bcStrings (6 0 ia81 F)) +-- (bcStrings (6 0 ia82 F)) +-- (bcStrings (6 0 ia83 F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Enter values of {\it b}: ") + (text . "\newline \tab{2} ") + (bcStrings (6 "-359" b1 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "281" b2 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "85" b3 F))) + htMakeDoneButton('"Continue",'f04arfGen) + htpSetProperty(page,'n,n) +-- htpSetProperty(page,'ia,ia) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +f04arfGen htPage == + n := htpProperty(htPage,'n) +-- ia := htpProperty(htPage,'ia) + ia := n + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + for i in 1..n repeat + right := STRCONC((first y).1," ") + y := rest y + bList := [right,:bList] + bstring := bcwords2liststring bList + y := REVERSE y + k := -1 + matform := [[y.(k := k + 1).1 for j in 0..(n-1)] for i in 0..(ia-1)] + matstring := bcwords2liststring [bcwords2liststring x for x in matform] + prefix := STRCONC('"f04arf(",STRINGIMAGE ia,", [",bstring,"],",STRINGIMAGE n) + prefix := STRCONC(prefix,", ",matstring,", ",STRINGIMAGE ifail,")") + bcGen prefix + +f04asf() == + htInitPage("F04ASF - Solution of real symmetric positive-definite simultaneous linear equations, one right-hand side using iterative refinement (Black box)",nil) + htMakePage '( + (domainConditions + (isDomain I (Integer))) + (text . "\windowlink{Manual Page}{manpageXXf04asf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04asf| '|NagLinearEquationSolvingPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\blankline ") + (text . "Calculates the accurate solution of a set of real symmetric ") + (text . "positive-definite linear equations {\it Ax = b} using an a ") + (text . "Cholesky factorization and iterative refinement, ") + (text . "where {\it A} is an n * n matrix, {\it x} is an n ") + (text . "element vector of unknowns and {\it b} is an n element ") + (text . "right-hand side vector.") + (text . "\blankline ") + (text . "\newline ") + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} ") +-- (text . "{\it IA} first dimension of A:") +-- (text . "\tab{32} \menuitemstyle{}\tab{34} ") + (text . "{\it n} order of matrix A:") + (text . "\newline\tab{2} ") +-- (bcStrings (10 8 ia I)) +-- (text . "\tab{34} ") + (bcStrings (10 4 n I)) + (text . "\blankline ") + (text . "\newline \menuitemstyle{} \tab{2} ") + (text . "Ifail value:") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'f04asfSolve) + htShowPage() + +f04asfSolve htPage == + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + ia := n +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ia) +-- objValUnwrap htpLabelSpadValue(htPage, 'ia) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 +-- (n = '4 and ia = '8) => f04asfDefaultSolve(htPage,ifail) + n = '4 => f04asfDefaultSolve(htPage,ifail) + matList := + "append"/[f(i,n) for i in 1..ia] where f(i,n) == + labelList := + "append"/[g(i,j) for j in 1..n] where g(i,j) == + ianam := INTERN STRCONC ('"ia",STRINGIMAGE i, STRINGIMAGE j) + [['bcStrings,[6, "0.0", ianam, 'F]]] + prefix := ('"\newline \tab{2} ") + labelList := [['text,:prefix],:labelList] + bmatList := + "append"/[h(k) for k in 1..n] where h(k) == + prefix := ('"\newline \tab{2} ") + bnam := INTERN STRCONC ('"b",STRINGIMAGE k) + [['text,:prefix],['bcStrings,[6, "0.0", bnam, 'F]]] + start := ('"\blankline \menuitemstyle{} \tab{2} Enter values of {\it b}:") + bmatList := [['text,:start],:bmatList] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain F (Float))), + :matList,:bmatList] + page := htInitPage("F04ASF - Solution of real symmetric positive-definite simultaneous linear equations, one right-hand side using iterative refinement (Black box)",nil) + htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " + htSay '"\newline \tab{2} " + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'f04asfGen) + htpSetProperty(page,'n,n) +-- htpSetProperty(page,'ia,ia) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + + +f04asfDefaultSolve (htPage, ifail) == + n := '4 + ia := '4 + page := htInitPage("F04ASF - Solution of real symmetric positive-definite simultaneous linear equations, one right-hand side using iterative refinement (Black box)",nil) + htMakePage '( + (domainConditions + (isDomain F (Float)) + (isDomain I (Integer))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ") + (text . "\newline \tab{2} ") + (bcStrings (6 5 ia11 F)) + (bcStrings (6 7 ia12 F)) + (bcStrings (6 6 ia13 F)) + (bcStrings (6 5 ia14 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 7 ia21 F)) + (bcStrings (6 10 ia22 F)) + (bcStrings (6 8 ia23 F)) + (bcStrings (6 7 ia24 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 6 ia31 F)) + (bcStrings (6 8 ia32 F)) + (bcStrings (6 10 ia33 F)) + (bcStrings (6 9 ia34 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 5 ia41 F)) + (bcStrings (6 7 ia42 F)) + (bcStrings (6 9 ia43 F)) + (bcStrings (6 10 ia44 F)) +-- (text . "\newline \tab{2} ") +-- (bcStrings (6 0 ia51 F)) +-- (bcStrings (6 0 ia52 F)) +-- (bcStrings (6 0 ia53 F)) +-- (bcStrings (6 0 ia54 F)) +-- (text . "\newline \tab{2} ") +-- (bcStrings (6 0 ia61 F)) +-- (bcStrings (6 0 ia62 F)) +-- (bcStrings (6 0 ia63 F)) +-- (bcStrings (6 0 ia64 F)) +-- (text . "\newline \tab{2} ") +-- (bcStrings (6 0 ia71 F)) +-- (bcStrings (6 0 ia72 F)) +-- (bcStrings (6 0 ia73 F)) +-- (bcStrings (6 0 ia74 F)) +-- (text . "\newline \tab{2} ") +-- (bcStrings (6 0 ia81 F)) +-- (bcStrings (6 0 ia82 F)) +-- (bcStrings (6 0 ia83 F)) +-- (bcStrings (6 0 ia84 F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Enter values of {\it b}: ") + (text . "\newline \tab{2} ") + (bcStrings (6 23 b1 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 32 b2 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 33 b3 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 31 b4 F))) + htMakeDoneButton('"Continue",'f04asfGen) + htpSetProperty(page,'n,n) +-- htpSetProperty(page,'ia,ia) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +f04asfGen htPage == + n := htpProperty(htPage,'n) +-- ia := htpProperty(htPage,'ia) + ia := n + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + for i in 1..n repeat + right := STRCONC((first y).1," ") + y := rest y + bList := [right,:bList] + bstring := bcwords2liststring bList + y := REVERSE y + k := -1 + matform := [[y.(k := k + 1).1 for j in 0..(n-1)] for i in 0..(ia-1)] + matstring := bcwords2liststring [bcwords2liststring x for x in matform] + prefix := STRCONC('"f04asf(",STRINGIMAGE ia,", [",bstring,"],",STRINGIMAGE n) + prefix := STRCONC(prefix,", ",matstring,", ",STRINGIMAGE ifail,")") + bcGen prefix + +f04atf() == + htInitPage("F04ATF - Solution of real simultaneous linear equations, one right-hand side using iterative refinement (Black box)",nil) + htMakePage '( + (domainConditions + (isDomain I (Integer))) + (text . "\windowlink{Manual Page}{manpageXXf04atf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04atf| '|NagLinearEquationSolvingPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\blankline ") + (text . "Calculates the approximate solution of a set of real linear ") + (text . "equations {\it Ax = b} using an {\it LU} factorization with ") + (text . "pivoting and iterative refinement, ") + (text . "where {\it A} is an n * n matrix, {\it x} is an n ") + (text . "element vector of unknowns and {\it b} is an n element ") + (text . "right-hand side vector.") + (text . "\blankline ") + (text . "\newline ") + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} ") +-- (text . "{\it IA} first dimension of A:") +-- (text . "\tab{32} \menuitemstyle{}\tab{34} ") + (text . "{\it n} order of matrix A:") + (text . "\newline\tab{2} ") +-- (bcStrings (10 8 ia I)) +-- (text . "\tab{34} ") + (bcStrings (10 3 n I)) +-- (text . "\blankline ") +-- (text . "\newline \menuitemstyle{} \tab{2} ") +-- (text . "{\it IAA} first dimension of AA:") +-- (text . "\newline \tab{2} ") +-- (bcStrings (10 8 iaa I)) + (text . "\blankline ") + (text . "\newline \menuitemstyle{} \tab{2} ") + (text . "Ifail value:") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'f04atfSolve) + htShowPage() + +f04atfSolve htPage == + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + ia := n +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ia) +-- objValUnwrap htpLabelSpadValue(htPage, 'ia) + iaa := n +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iaa) +-- objValUnwrap htpLabelSpadValue(htPage, 'iaa) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 +-- (n = '3 and ia = '8) => f04atfDefaultSolve(htPage,iaa,ifail) + n = '3 => f04atfDefaultSolve(htPage,iaa,ifail) + matList := + "append"/[f(i,n) for i in 1..ia] where f(i,n) == + labelList := + "append"/[g(i,j) for j in 1..n] where g(i,j) == + ianam := INTERN STRCONC ('"ia",STRINGIMAGE i, STRINGIMAGE j) + [['bcStrings,[6, "0.0", ianam, 'F]]] + prefix := ('"\newline \tab{2} ") + labelList := [['text,:prefix],:labelList] + bmatList := + "append"/[h(k) for k in 1..n] where h(k) == + prefix := ('"\newline \tab{2} ") + bnam := INTERN STRCONC ('"b",STRINGIMAGE k) + [['text,:prefix],['bcStrings,[6, "0.0", bnam, 'F]]] + start := ('"\blankline \menuitemstyle{} \tab{2} Enter values of {\it b}:") + bmatList := [['text,:start],:bmatList] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain F (Float))), + :matList,:bmatList] + page := htInitPage("F04ATF - Solution of real simultaneous linear equations, one right-hand side using iterative refinement (Black box)",nil) + htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " + htSay '"\newline \tab{2} " + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'f04atfGen) + htpSetProperty(page,'n,n) +-- htpSetProperty(page,'ia,ia) +-- htpSetProperty(page,'iaa,iaa) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + + +f04atfDefaultSolve (htPage, iaa, ifail) == + n := '3 + ia := '3 + page := htInitPage("F04ATF - Solution of real simultaneous linear equations, one right-hand side using iterative refinement (Black box)",nil) + htMakePage '( + (domainConditions + (isDomain F (Float)) + (isDomain I (Integer))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ") + (text . "\newline \tab{2} ") + (bcStrings (6 33 ia11 F)) + (bcStrings (6 16 ia12 F)) + (bcStrings (6 72 ia13 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "-24" ia21 F)) + (bcStrings (6 "-10" ia22 F)) + (bcStrings (6 "-57" ia23 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "-8" ia31 F)) + (bcStrings (6 "-4" ia32 F)) + (bcStrings (6 "-17" ia33 F)) +-- (text . "\newline \tab{2} ") +-- (bcStrings (6 0 ia41 F)) +-- (bcStrings (6 0 ia42 F)) +-- (bcStrings (6 0 ia43 F)) +-- (text . "\newline \tab{2} ") +-- (bcStrings (6 0 ia51 F)) +-- (bcStrings (6 0 ia52 F)) +-- (bcStrings (6 0 ia53 F)) +-- (text . "\newline \tab{2} ") +-- (bcStrings (6 0 ia61 F)) +-- (bcStrings (6 0 ia62 F)) +-- (bcStrings (6 0 ia63 F)) +-- (text . "\newline \tab{2} ") +-- (bcStrings (6 0 ia71 F)) +-- (bcStrings (6 0 ia72 F)) +-- (bcStrings (6 0 ia73 F)) +-- (text . "\newline \tab{2} ") +-- (bcStrings (6 0 ia81 F)) +-- (bcStrings (6 0 ia82 F)) +-- (bcStrings (6 0 ia83 F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Enter values of {\it b}: ") + (text . "\newline \tab{2} ") + (bcStrings (6 "-359" b1 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "281" b2 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "85" b3 F))) + htMakeDoneButton('"Continue",'f04atfGen) + htpSetProperty(page,'n,n) +-- htpSetProperty(page,'ia,ia) +-- htpSetProperty(page,'iaa,iaa) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +f04atfGen htPage == + n := htpProperty(htPage,'n) +-- ia := htpProperty(htPage,'ia) +-- iaa := htpProperty(htPage,'iaa) + ia := n + iaa := n + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + for i in 1..n repeat + right := STRCONC((first y).1," ") + y := rest y + bList := [right,:bList] + bstring := bcwords2liststring bList + y := REVERSE y + k := -1 + matform := [[y.(k := k + 1).1 for j in 0..(n-1)] for i in 0..(ia-1)] + matstring := bcwords2liststring [bcwords2liststring x for x in matform] + prefix := STRCONC('"f04atf(",matstring,", ",STRINGIMAGE ia,", [",bstring) + prefix := STRCONC(prefix,"],",STRINGIMAGE n,", ",STRINGIMAGE iaa,", ") + prefix := STRCONC(prefix,STRINGIMAGE ifail,")") + bcGen prefix + + +f04faf() == + htInitPage('"F04FAF - Solution of real symmetric positive-definite tridiagonal simultaneous linear equations, one right-hand side (Black box)",nil) + htMakePage '( + (domainConditions + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXf04adf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04faf| '|NagLinearEquationSolvingPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\blankline ") + (text . "Calculates the approximate solution of a set of real symmetric ") + (text . "positive-definite tridiagonal linear equations {\it Tx = b} ") + (text . "using a modified symmetric Gaussian Elimination algorithm, ") + (text . "where {\it T} is an n * n matrix, {\it x} is an n ") + (text . "element vector of unknowns and {\it b} is an n element ") + (text . "right-hand side vector. {\it T} is factorized as ") + (text . "\inputbitmap{\htbmdir{}/mkm.bitmap}, where {\it K} is a diagonal matrix ") + (text . "and {\it M} is a matrix of multipliers. ") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "{\it JOB} to be performed by f04faf: ") + (radioButtons job + ("" " = 0. {\it T} is factorized and equations {\it Tx = b} are solved for x." jobZero) + ("" " = 1. {\it T} assumed to be already factorized by previous call to f04faf, the equations {\it Tx = b} are solved for x." jobOne)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "\newline Order of the matrix T {\it n}:") + (text . "\newline \tab{2} ") + (bcStrings (6 5 n PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Ifail value: ") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'f04fafSolve) + htShowPage() + +f04fafSolve htPage == + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + number := htpButtonValue(htPage,'job) + job := + number = 'jobOne => '1 + '0 + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + n = '5 => f04fafDefaultSolve(htPage,job,ifail) + dList := + "append"/[f(i) for i in 1..n] where f(i) == + prefix := ('"\newline \tab{2} ") + dnam := INTERN STRCONC ('"d",STRINGIMAGE i) + [['text,:prefix],['bcStrings,[10, 0.0, dnam, 'F]]] + prefix := ('"\menuitemstyle{}\tab{2} {\it D} Diagonal elements of T: ") + prefix := STRCONC(prefix,"\newline \tab{2} ") + dList := [['text,:prefix],:dList] + eList := + "append"/[g(j) for j in 1..(n-1)] where g(j) == + prefix := ('"\newline \tab{2} ") + enam := INTERN STRCONC ('"e",STRINGIMAGE j) + [['text,:prefix],['bcStrings,[10, 0.0, enam, 'F]]] + prefix := ('"\blankline \newline \menuitemstyle{}\tab{2} {\it E} E(2) ") + prefix := STRCONC(prefix,"to E(N)\newline \tab{2} Job = 0 => super-diagonal") + prefix := STRCONC(prefix," elements of {\it T}. \newline \tab{2} Job = 1 =>") + prefix := STRCONC(prefix," off-diagonal elements of {\it M} from previous ") + prefix := STRCONC(prefix,"call to F04FAF. ") + eList := [['text,:prefix],:eList] + bList := + "append"/[h(k) for k in 1..n] where h(k) == + prefix := ('"\newline \tab{2} ") + bnam := INTERN STRCONC ('"b",STRINGIMAGE k) + [['text,:prefix],['bcStrings,[10, 0.0, bnam, 'F]]] + prefix := ('"\blankline \newline \menuitemstyle{}\tab{2} {\it B} Right-hand") + prefix := STRCONC(prefix," side vector b: ") + bList := [['text,:prefix],:bList] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :dList,:eList,:bList] + page := htInitPage("F04FAF - Solution of real symmetric positive-definite tridiagonal simultaneous linear equations, one right-hand side (Black box)",nil) + htMakePage equationPart + htMakeDoneButton('"Continue",'f04fafGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'job,job) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +f04fafDefaultSolve (htPage,job,ifail) == + n := '5 + page := htInitPage('"F04FAF - Solution of real symmetric positive-definite tridiagonal simultaneous linear equations, one right-hand side (Black box)",nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} {\it D} Diagonal elements of T:") + (text . "\newline \tab{2} ") + (bcStrings (10 4 d1 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 10 d2 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 29 d3 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 25 d4 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 5 d5 F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} {\it E}\space{1} E(2) to E(N) ") + (text . "\newline \tab{2} ") + (text . "Job = 0 => super-diagonal elements of {\it T}. \newline \tab{2}") + (text . "Job = 1 => off-diagonal elements of {\it M} from ") + (text . "previous call to F04FAF \newline \tab{2} ") + (bcStrings (10 "-2" e2 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 "-6" e3 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 15 e4 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 8 e5 F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} {\it B} Right-hand side vector b:") + (text . "\newline \tab{2} ") + (bcStrings (10 6 b1 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 9 b2 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 2 b3 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 14 b4 F)) + (text . "\newline \tab{2} ") + (bcStrings (10 7 b5 F))) + htMakeDoneButton('"Continue",'f04fafGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'job,job) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +f04fafGen htPage == + n := htpProperty(htPage,'n) + job := htpProperty(htPage,'job) + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + for i in 1..n repeat + b := STRCONC((first y).1," ") + bList := [b,:bList] + y := rest y + bstring := bcwords2liststring bList + for i in 1..(n-1) repeat + e := STRCONC((first y).1," ") + eList := [e,:eList] + y := rest y + eList := ['"0",:eList] + estring := bcwords2liststring eList + for i in 1..n repeat + d := STRCONC((first y).1," ") + dList := [d,:dList] + y := rest y + dstring := bcwords2liststring dList + prefix := STRCONC('"f04faf(",STRINGIMAGE job,", ",STRINGIMAGE n,",[") + prefix := STRCONC(prefix,dstring,"], [",estring,"], [",bstring,"], ") + prefix := STRCONC(prefix,STRINGIMAGE ifail,")") + bcGen prefix + + +f04jgf() == + htInitPage('"F04JGF - Least-squares (if rank = n) or minimal least-squares (if rank < n) solution of m real equations in n unknowns, rank \inputbitmap{\htbmdir{}/less=.bitmap} it n, m \inputbitmap{\htbmdir{}/great=.bitmap} n",nil) + htMakePage '( + (domainConditions + (isDomain F (Float)) + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXf04jgf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04jgf| '|NagLinearEquationSolvingPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\blankline ") + (text . "Finds the solution of a linear least squares problem {\it Ax=b},") + (text . " where A is a real m by n matrix, (m \inputbitmap{\htbmdir{}/great=.bitmap}") + (text . " n), x is an n element vector of unknowns and b is an m element ") + (text . "right-hand side vector. The routine uses a QU factorization if ") + (text . "rank A = n and the SVD if A < n. ") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline Rows of matrix A, {\it m}: ") + (text . "\tab{32} \menuitemstyle{} \tab{34} ") + (text . "Columns of matrix A, {\it n}: \newline \tab{2} ") + (bcStrings (6 6 m PI)) + (text . "\tab{34} ") + (bcStrings (6 4 n PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") +-- (text . "\newline First dimension of A, {\it nra}: ") +-- (text . "\tab{32} \menuitemstyle{} \tab{34} ") + (text . "Tolerance, {\it tol}: ") + (text . "\newline \tab{2} ") +-- (bcStrings (6 8 nra PI)) +-- (text . "\tab{34} ") + (bcStrings (8 "5.0e-4" tol F)) +-- (text . "\blankline ") +-- (text . "\newline ") +-- (text . "\menuitemstyle{}\tab{2}") +-- (text . "\newline Dimension of workspace array {\it lwork}: ") +-- (text . "\newline \tab{2} ") +-- (bcStrings (6 32 lwork PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Ifail value: ") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'f04jgfSolve) + htShowPage() + +f04jgfSolve htPage == + m := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) + objValUnwrap htpLabelSpadValue(htPage, 'm) + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + nra := m +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nra) +-- objValUnwrap htpLabelSpadValue(htPage, 'nra) + lwork := 4*n +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lwork) +-- objValUnwrap htpLabelSpadValue(htPage, 'lwork) + tol := htpLabelInputString(htPage,'tol) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + (m = '6 and n = '4) => f04jgfDefaultSolve(htPage,nra,lwork,tol,ifail) + matList := + "append"/[f(i,n) for i in 1..m] where f(i,n) == + labelList := + "append"/[g(i,j) for j in 1..n] where g(i,j) == + anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) + [['bcStrings,[6, "0.0", anam, 'F]]] + prefix := ('"\newline \tab{2} ") + labelList := [['text,:prefix],:labelList] + bmatList := + "append"/[h(k) for k in 1..m] where h(k) == + prefix := ('"\newline \tab{2} ") + bnam := INTERN STRCONC ('"b",STRINGIMAGE k) + [['text,:prefix],['bcStrings,[6, "0.0", bnam, 'F]]] + start := ('"\blankline \menuitemstyle{} \tab{2} Enter values of {\it b}:") + bmatList := [['text,:start],:bmatList] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :matList,:bmatList] + page := htInitPage("F04JGF - Least-squares (if rank = {\it n}) or minimal least-squares (if rank < {\it n}) solution of {\it m} real equations in {\it n} unknowns, rank \inputbitmap{\htbmdir{}/less=.bitmap} {\it n}, {\it m} \inputbitmap{\htbmdir{}/great=.bitmap} {\it n}",nil) + htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " + htSay '"\newline \tab{2} " + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'f04jgfGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'m,m) +-- htpSetProperty(page,'nra,nra) +-- htpSetProperty(page,'lwork,lwork) + htpSetProperty(page,'tol,tol) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +f04jgfDefaultSolve (htPage,nra,lwork,tol,ifail) == + n := '4 + m := '6 + page := htInitPage('"F04JGF - Least-squares (if rank = n) or minimal least-squares (if rank < n) solution of m real equations in n unknowns, rank \inputbitmap{\htbmdir{}/less=.bitmap} n, m \inputbitmap{\htbmdir{}/great=.bitmap} n",nil) + htMakePage '( + (domainConditions + (isDomain F (Float)) + (isDomain I (Integer))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ") + (text . "\newline \tab{2} ") + (bcStrings (6 "0.05" a11 F)) + (bcStrings (6 "0.05" a12 F)) + (bcStrings (6 "0.25" a13 F)) + (bcStrings (6 "-0.25" a14 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.25" a21 F)) + (bcStrings (6 "0.25" a22 F)) + (bcStrings (6 "0.05" a23 F)) + (bcStrings (6 "-0.05" a24 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.35" a31 F)) + (bcStrings (6 "0.35" a32 F)) + (bcStrings (6 "1.75" a33 F)) + (bcStrings (6 "-1.75" a34 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "1.75" a41 F)) + (bcStrings (6 "1.75" a42 F)) + (bcStrings (6 "0.35" a43 F)) + (bcStrings (6 "-0.35" a44 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.30" a51 F)) + (bcStrings (6 "-0.30" a52 F)) + (bcStrings (6 "0.30" a53 F)) + (bcStrings (6 "0.30" a54 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.40" a61 F)) + (bcStrings (6 "-0.40" a62 F)) + (bcStrings (6 "0.40" a63 F)) + (bcStrings (6 "0.40" a64 F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Enter values of {\it b}: ") + (text . "\newline \tab{2} ") + (bcStrings (6 1 b1 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 2 b2 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 3 b3 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 4 b4 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 5 b5 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 6 b6 F))) + htMakeDoneButton('"Continue",'f04jgfGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'m,m) +-- htpSetProperty(page,'nra,nra) +-- htpSetProperty(page,'lwork,lwork) + htpSetProperty(page,'tol,tol) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +f04jgfGen htPage == + n := htpProperty(htPage,'n) + m := htpProperty(htPage,'m) +-- nra := htpProperty(htPage,'nra) +-- lwork := htpProperty(htPage,'lwork) + nra := m + lwork := 4*n + tol := htpProperty(htPage,'tol) + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + for i in 1..m repeat + b := STRCONC((first y).1," ") + bList := [b,:bList] + y := rest y + bstring := bcwords2liststring bList + y := REVERSE y + for i in 1..m repeat + for j in 1..n repeat + elm := STRCONC((first y).1," ") + rowList := [:rowList,elm] + y := rest y + matform := [:matform,rowList] + rowList := [] + for i in 1..n repeat + null := STRCONC('"0.0"," ") + nullList := [:nullList,null] + for i in m..(nra-1) repeat + matform := [:matform,nullList] + matstring := bcwords2liststring [bcwords2liststring x for x in matform] + prefix := STRCONC('"f04jgf(",STRINGIMAGE m,", ",STRINGIMAGE n,", ") + prefix := STRCONC(prefix,STRINGIMAGE nra,", ",tol,", ",STRINGIMAGE lwork) + prefix := STRCONC(prefix,", ",matstring,", [",bstring,"], ") + prefix := STRCONC(prefix,STRINGIMAGE ifail,")") + bcGen prefix + +f04mcf() == + htInitPage("F04MCF - Approximate solution of real symmetric positive-definite variable-bandwidth simultaneous linear equations (coefficient matrix already factorized)",nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\windowlink{Manual Page}{manpageXXf04mcf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04mcf| '|NagLinearEquationSolvingPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "Computes the approximate solution of a system of real linear ") + (text . "equations AX = B, where the n by n symmetric positive-definite ") + (text . "variable-bandwidth matrix A has previously been factorized as ") + (text . "\htbitmap{ldlt} by F01MCF, X is an n by r matrix of unknowns ") + (text . "and B is an n by r matrix of right-hand sides. Related systems ") + (text . "may also be solved. ") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the order of the matrix A, {\it n} ") + (text ."\htbitmap{great=} 1:") + (text . "\newline\tab{2} ") + (bcStrings (9 6 n PI)) + (text . "\blankline") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "\newline Enter the dimension of AL, {\it lal}: ") + (text . "\newline\tab{2} ") + (bcStrings (9 14 lal PI)) + (text . "\blankline") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "\newline Enter the number of right-hand sides, {\it ir}: ") + (text . "\newline\tab{2} ") + (bcStrings (9 2 ir PI)) +-- (text . "\blankline") +-- (text . "\newline ") +-- (text . "\menuitemstyle{}\tab{2}") +-- (text . "\newline Enter the first dimension of B, {\it nrb}: ") +-- (text . "\newline\tab{2} ") +-- (bcStrings (9 6 nrb PI)) +-- (text . "\blankline") +-- (text . "\newline ") +-- (text . "\menuitemstyle{}\tab{2}") +-- (text . "\newline Enter the first dimension of X, {\it nrx}: ") +-- (text . "\newline\tab{2} ") +-- (bcStrings (9 6 nrx PI)) + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} ") + (text . "Type of system to be solved, {\it iselct}:") + (radioButtons iselct + ("" " {\em \htbitmap{ldlt}X = B} is solved" selone) + ("" " {\em LDX = B} is solved" seltwo) + ("" " {\em D\htbitmap{lt}X = B} is solved" selthree) + ("" " {\em L\htbitmap{lt}X = B} is solved" selfour) + ("" " {\em LX = B} is solved" selfive) + ("" " {\em \htbitmap{lt}X = B} is solved" selsix)) + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} Ifail value:") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'f04mcfSolve) + htShowPage() + +f04mcfSolve htPage == + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + lal := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lal) + objValUnwrap htpLabelSpadValue(htPage, 'lal) + ir := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ir) + objValUnwrap htpLabelSpadValue(htPage, 'ir) + nrb := n +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nrb) +-- objValUnwrap htpLabelSpadValue(htPage, 'nrb) + nrx := n +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nrx) +-- objValUnwrap htpLabelSpadValue(htPage, 'nrx) + select := htpButtonValue(htPage,'iselct) + iselct := + select = 'selone => '1 + select = 'seltwo => '2 + select = 'selthree => '3 + select = 'selfour => '4 + select = 'selfive => '5 + '6 + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + (n = '6 and lal = '14 and ir = '2) => f04mcfDefaultSolve(htPage,iselct,ifail) + labelList := + "append"/[fal(i) for i in 1..lal] where fal(i) == + xnam := INTERN STRCONC ('"x",STRINGIMAGE i) + [['bcStrings,[6, "0.0", xnam, 'F]]] + dList := + "append"/[fd(i) for i in 1..n] where fd(i) == + dnam := INTERN STRCONC ('"d",STRINGIMAGE i) + [['bcStrings,[6, "0.0", dnam, 'F]]] + prefix := ('"\blankline \menuitemstyle{}\tab{2} Diagonal elements of diagon") + prefix := STRCONC(prefix,"al matrix D as returned by F01MCF: \newline") + dList := [['text,:prefix],:dList] + nrowList := + "append"/[gj(j) for j in 1..n] where gj(j) == + nam := INTERN STRCONC ('"n",STRINGIMAGE j) + [['bcStrings,[6, 0, nam, 'PI]]] + prefix := ('"\blankline \menuitemstyle{}\tab{2} {\it NROW(n)} the width ") + prefix := STRCONC(prefix,"of the ith row of A: \newline ") + nrowList := [['text,:prefix],:nrowList] + bList := + "append"/[f(i,ir) for i in 1..nrb] where f(i,ir) == + labelList := + "append"/[g(i,j) for j in 1..ir] where g(i,j) == + bnam := INTERN STRCONC ('"b",STRINGIMAGE i, STRINGIMAGE j) + [['bcStrings,[6, "0.0", bnam, 'F]]] + prefix := ('"\newline ") + labelList := [['text,:prefix],:labelList] + prefix := ('"\blankline \menuitemstyle{}\tab{2} The n by r right-hand side ") + prefix := STRCONC(prefix,"matrix B: \newline ") + bList := [['text,:prefix],:bList] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain PI (PositiveInteger))), + :labelList,:dList,:nrowList,:bList] + page := htInitPage("F04MCF - Approximate solution of real symmetric positive-definite variable-bandwidth simultaneous linear equations (coefficient matrix already factorized)",nil) + htSay '"\menuitemstyle{}\tab{2} Elements of matrix {\it AL} in row by row " + htSay '"order as returned by F01MCF: \newline " + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'f04mcfGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'lal,lal) + htpSetProperty(page,'ir,ir) +-- htpSetProperty(page,'nrb,nrb) +-- htpSetProperty(page,'nrx,nrx) + htpSetProperty(page,'iselct,iselct) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + +f04mcfDefaultSolve (htPage,iselct,ifail) == + n := '6 + lal := '14 + ir := '2 + nrb := '6 + nrx := '6 + page := htInitPage("F04MCF - Approximate solution of real symmetric positive-definite variable-bandwidth simultaneous linear equations (coefficient matrix already factorized)",nil) + htMakePage '( + (domainConditions + (isDomain PI (Positive Integer)) + (isDomain F (Float))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} Elements of matrix {\it AL} in row by ") + (text . "row order as returned by F01MCF: ") + (text . "\newline ") + (bcStrings (6 "1.0" x1 F)) + (bcStrings (6 "2.0" x2 F)) + (bcStrings (6 "1.0" x3 F)) + (bcStrings (6 "3.0" x4 F)) + (bcStrings (6 "1.0" x5 F)) + (bcStrings (6 "1.0" x6 F)) + (bcStrings (6 "5.0" x7 F)) + (bcStrings (6 "4.0" x8 F)) + (bcStrings (6 "1.5" x9 F)) + (bcStrings (6 "0.5" x10 F)) + (bcStrings (6 "1.0" x11 F)) + (bcStrings (6 "1.5" x12 F)) + (bcStrings (6 "5.0" x13 F)) + (bcStrings (6 "1.0" x14 F)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2} Diagonal elements of diagonal matrix ") + (text . "D as returned by F01MCF: ") + (text . "\newline ") + (bcStrings (6 "1.0" d1 F)) + (bcStrings (6 "1.0" d2 F)) + (bcStrings (6 "4.0" d3 F)) + (bcStrings (6 "16.0" d4 F)) + (bcStrings (6 "1.0" d5 F)) + (bcStrings (6 "16.0" d6 F)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2} {\it NROW(n)} the width of the ith row ") + (text . "of A: ") + (text . "\newline ") + (bcStrings (6 1 n1 PI)) + (bcStrings (6 2 n2 PI)) + (bcStrings (6 2 n3 PI)) + (bcStrings (6 1 n4 PI)) + (bcStrings (6 5 n5 PI)) + (bcStrings (6 3 n6 PI)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2} The n by r right-hand side matrix B:") + (text . "\newline ") + (bcStrings (6 "6" b11 F)) + (text . "\tab{10} ") + (bcStrings (6 "-10" b12 PI)) + (text . "\newline ") + (bcStrings (6 "15" b21 F)) + (text . "\tab{10} ") + (bcStrings (6 "-21" b22 PI)) + (text . "\newline ") + (bcStrings (6 "11" b31 F)) + (text . "\tab{10} ") + (bcStrings (6 "-3" b32 PI)) + (text . "\newline ") + (bcStrings (6 "0" b41 F)) + (text . "\tab{10} ") + (bcStrings (6 "24" b42 PI)) + (text . "\newline ") + (bcStrings (6 "51" b51 F)) + (text . "\tab{10} ") + (bcStrings (6 "-39" b52 PI)) + (text . "\newline ") + (bcStrings (6 "46" b61 F)) + (text . "\tab{10} ") + (bcStrings (6 "67" b62 PI)) + (text . "\blankline ")) + htMakeDoneButton('"Continue",'f04mcfGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'lal,lal) + htpSetProperty(page,'ir,ir) +-- htpSetProperty(page,'nrb,nrb) +-- htpSetProperty(page,'nrx,nrx) + htpSetProperty(page,'iselct,iselct) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +f04mcfGen htPage == + n := htpProperty(htPage,'n) + lal := htpProperty(htPage,'lal) + ir := htpProperty(htPage,'ir) +-- nrb := htpProperty(htPage,'nrb) +-- nrx := htpProperty(htPage,'nrx) + nrb := n + nrx := n + iselct := htpProperty(htPage,'iselct) + ifail := htpProperty(htPage,'ifail) + alist := htpInputAreaAlist htPage + y := alist + for i in 1..nrb repeat + for j in 1..ir repeat + elm := STRCONC((first y).1," ") + rowList := [elm,:rowList] + y := rest y + matform := [rowList,:matform] + rowList := [] + matfrom := REVERSE matform + matstring := bcwords2liststring [bcwords2liststring x for x in matform] + for i in 1..n repeat + right := STRCONC ((first y).1," ") + y := rest y + nrowList := [right,:nrowList] + nrowstring := bcwords2liststring nrowList + for i in 1..n repeat + right := STRCONC ((first y).1," ") + y := rest y + dList := [right,:dList] + dstring := bcwords2liststring dList + while y repeat + right := STRCONC ((first y).1," ") + y := rest y + alList := [right,:alList] + alstring := bcwords2liststring alList + prefix := STRCONC('"f04mcf(",STRINGIMAGE n,", [",alstring,"], ") + prefix := STRCONC(prefix,STRINGIMAGE lal,", [",dstring,"],[",nrowstring) + prefix := STRCONC(prefix,"]::Matrix Integer,") + prefix := STRCONC(prefix,STRINGIMAGE ir,", ",matstring,", ",STRINGIMAGE nrb) + prefix := STRCONC(prefix,", ",STRINGIMAGE iselct,", ",STRINGIMAGE nrx,", ") + bcGen STRCONC(prefix,STRINGIMAGE ifail,")") + + +f04axf() == + htInitPage('"F04AXF - Approximate solution of a a set of real sparse linear equations after factorization by F01BRF or by F01BSF",nil) + htMakePage '( + (domainConditions + (isDomain EM $EmptyMode) + (isDomain F (Float))) + (text . "\windowlink{Manual Page}{manpageXXf04axf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04axf| '|NagLinearEquationSolvingPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\newline ") + (text . "F04AXF calculates the approximate solution of a set of real ") + (text . "sparse linear equations {\it Ax=b} or ") + (text . "\htbitmap{aTx=b}, where the {\it n} by {\it n} matrix ") + (text . "{\it A} has been factorized by F01BRF or F01BSF, {\it x} ") + (text . "is an {\it n} element vector of unknowns and {\it b} is an ") + (text . "{\it n} element right-hand side vector. ") + (text . "\blankline") + (text . "\newline ") + (text . "Read the input file to see the example program. ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "\spadcommand{)read f04axf \bound{s0}} ")) + htShowPage() + +f04maf() == + htInitPage('"F04MAF - Solution of a real sparse symmetric positive-definite system of linear equations after factorization by F01MAF",nil) + htMakePage '( + (domainConditions + (isDomain EM $EmptyMode) + (isDomain F (Float))) + (text . "\windowlink{Manual Page}{manpageXXf04maf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04maf| '|NagLinearEquationSolvingPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\newline ") + (text . "F04MAF solves a real sparse symmetric positive-definite system ") + (text . "of linear equations {\it Ax=b} using a pre-conditioned ") + (text . "conjugate gradient method, where the {\it n} by {\it n} ") + (text . "matrix {\it A} has been factorized by F01MAF, {\it x} is an ") + (text . "{\it n} element vector of unknowns and {\it b} is an {\it n} ") + (text . "element right-hand side vector. ") + (text . "\blankline") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "\spadcommand{)read f04maf \bound{s0}} ")) + htShowPage() + +f04mbf() == + htInitPage('"F04MBF - Real sparse symmetric simultaneous linear equations",nil) + htMakePage '( + (domainConditions + (isDomain EM $EmptyMode) + (isDomain PI (PositiveInteger)) + (isDomain F (Float))) + (text . "\windowlink{Manual Page}{manpageXXf04mbf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04mbf| '|NagLinearEquationSolvingPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\newline ") + (text . "F04MBF solve a system of real symmetric linear equations ") + (text . "({\it A} - \lambda {\it I}){\it x} = {\it b} using a Lanczos ") + (text . "algorithm, where {\it A} is an {\it n} by {\it n} sparse ") + (text . "symmetric matrix, {\it x} is an {\it n} vector of unknowns ") + (text . "and {\it b} is an {\it n} element right-hand side vector. ") + (text . "\blankline") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Enter the order {\it n} of matrix {\it A}: ") + (text . "\newline \tab{2} ") + (bcStrings (10 10 n PI)) + (text . "\blankline") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Is preconditioning required? ") + (radioButtons precon + ("" " Yes" true) + ("" " No" false)) + (text . "\blankline") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Enter the shift in the equations \lambda, {\it shift} : ") + (text . "\newline \tab{2} ") + (bcStrings (10 "0.0" shift F)) + (text . "\blankline") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Enter the tolerance for convergence, {\it rtol}: ") + (text . "\newline \tab{2} ") + (bcStrings (10 "0.00001" rtol F)) + (text . "\blankline") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Enter an upper limit for the number of iterations, {\it itnlim}: ") + (text . "\newline \tab{2} ") + (bcStrings (10 100 itnlim PI)) + (text . "\blankline") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Enter the printing level, {\it msglvl}: ") + (text . "\newline \tab{2} ") + (bcStrings (10 1 msglvl 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", 'f04mbfSolve) + htShowPage() + +f04mbfSolve htPage == + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + msolve := htpButtonValue(htPage,'precon) + precon := + msolve = 'true => 'true + 'false + shift := htpLabelInputString(htPage,'shift) + rtol := htpLabelInputString(htPage,'rtol) + itnlim := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'itnlim) + objValUnwrap htpLabelSpadValue(htPage, 'itnlim) + msglvl := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'msglvl) + objValUnwrap htpLabelSpadValue(htPage, 'msglvl) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + (n = '10 and precon ='true) => f04mbfDefaultSolve(htPage,shift,rtol,itnlim,msglvl,ifail) + bmatList := + "append"/[f(i) for i in 1..n] where f(i) == + bnam := INTERN STRCONC ('"b",STRINGIMAGE i) + [['bcStrings,[6, "0.0", bnam, 'F]]] + amatList := + "append"/[h(ia,n) for ia in 1..n] where h(ia,n) == + alabelList := + "append"/[k(ia,ja) for ja in 1..n] where k(ia,ja) == + anam := INTERN STRCONC ('"a",STRINGIMAGE ia,STRINGIMAGE ja) + [['bcStrings,[6, "0.0", anam, 'F]]] + prefix := ('"\newline \tab{2} ") + alabelList := [['text,:prefix],:alabelList] + start := ('"\blankline \menuitemstyle{}\tab{2} Enter the matrix {\it A}: ") + amatList := [['text,:start],:amatList] + mmatList:= + precon = 'true => + alabelList:= + "append"/[l(im,n) for im in 1..n] where l(im,n) == + mlabelList := + "append"/[o(im,jm) for jm in 1..n] where o(im,jm) == + mnam := INTERN STRCONC ('"m",STRINGIMAGE im,STRINGIMAGE jm) + [['bcStrings,[6, "0.0", mnam, 'F]]] + prefix := ('"\newline \tab{2} ") + mlabelList := [['text,:prefix],:mlabelList] + start := ('"\blankline \menuitemstyle{}\tab{2} Enter the matrix {\it m}: ") + [['text,:start],:alabelList] + [] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain F (Float))), + :bmatList,:amatList,:mmatList] + page := htInitPage('"F04MBF - Real sparse symmetric simultaneous linear equations",nil) + htSay '"\newline \menuitemstyle{}\tab{2} " + htSay '"Enter the right-hand side vector {\it b(n)}: " + htSay '"\newline \tab{2} " + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'f04mbfGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'precon,precon) + htpSetProperty(page,'shift,shift) + htpSetProperty(page,'rtol,rtol) + htpSetProperty(page,'itnlim,itnlim) + htpSetProperty(page,'msglvl,msglvl) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +f04mbfDefaultSolve (htPage,shift,rtol,itnlim,msglvl,ifail) == + n := '10 + precon := 'true + page := htInitPage('"F04MBF - Real sparse symmetric simultaneous linear equations",nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Enter the right-hand side vector {\it b(n)}: ") + (text . "\newline \tab{2} ") + (bcStrings (6 "6.0" b1 F)) + (bcStrings (6 "4.0" b2 F)) + (bcStrings (6 "4.0" b3 F)) + (bcStrings (6 "4.0" b4 F)) + (bcStrings (6 "4.0" b5 F)) + (bcStrings (6 "4.0" b6 F)) + (bcStrings (6 "4.0" b7 F)) + (bcStrings (6 "4.0" b8 F)) + (bcStrings (6 "4.0" b9 F)) + (bcStrings (6 "6.0" b10 F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Enter the matrix {\it A}: ") + (text . "\newline \tab{2} ") + (bcStrings (6 "2.0" a11 F)) + (bcStrings (6 "1.0" a12 F)) + (bcStrings (6 "0.0" a13 F)) + (bcStrings (6 "0.0" a14 F)) + (bcStrings (6 "0.0" a15 F)) + (bcStrings (6 "0.0" a16 F)) + (bcStrings (6 "0.0" a17 F)) + (bcStrings (6 "0.0" a18 F)) + (bcStrings (6 "0.0" a19 F)) + (bcStrings (6 "3.0" a110 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "1.0" a21 F)) + (bcStrings (6 "2.0" a22 F)) + (bcStrings (6 "1.0" a23 F)) + (bcStrings (6 "0.0" a24 F)) + (bcStrings (6 "0.0" a25 F)) + (bcStrings (6 "0.0" a26 F)) + (bcStrings (6 "0.0" a27 F)) + (bcStrings (6 "0.0" a28 F)) + (bcStrings (6 "0.0" a29 F)) + (bcStrings (6 "0.0" a210 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" a31 F)) + (bcStrings (6 "1.0" a32 F)) + (bcStrings (6 "2.0" a33 F)) + (bcStrings (6 "1.0" a34 F)) + (bcStrings (6 "0.0" a35 F)) + (bcStrings (6 "0.0" a36 F)) + (bcStrings (6 "0.0" a37 F)) + (bcStrings (6 "0.0" a38 F)) + (bcStrings (6 "0.0" a39 F)) + (bcStrings (6 "0.0" a310 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" a41 F)) + (bcStrings (6 "0.0" a42 F)) + (bcStrings (6 "1.0" a43 F)) + (bcStrings (6 "2.0" a44 F)) + (bcStrings (6 "1.0" a45 F)) + (bcStrings (6 "0.0" a46 F)) + (bcStrings (6 "0.0" a47 F)) + (bcStrings (6 "0.0" a48 F)) + (bcStrings (6 "0.0" a49 F)) + (bcStrings (6 "0.0" a410 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" a51 F)) + (bcStrings (6 "0.0" a52 F)) + (bcStrings (6 "0.0" a53 F)) + (bcStrings (6 "1.0" a54 F)) + (bcStrings (6 "2.0" a55 F)) + (bcStrings (6 "1.0" a56 F)) + (bcStrings (6 "0.0" a57 F)) + (bcStrings (6 "0.0" a58 F)) + (bcStrings (6 "0.0" a59 F)) + (bcStrings (6 "0.0" a510 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" a61 F)) + (bcStrings (6 "0.0" a62 F)) + (bcStrings (6 "0.0" a63 F)) + (bcStrings (6 "0.0" a64 F)) + (bcStrings (6 "1.0" a65 F)) + (bcStrings (6 "2.0" a66 F)) + (bcStrings (6 "1.0" a67 F)) + (bcStrings (6 "0.0" a68 F)) + (bcStrings (6 "0.0" a69 F)) + (bcStrings (6 "0.0" a610 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" a71 F)) + (bcStrings (6 "0.0" a72 F)) + (bcStrings (6 "0.0" a73 F)) + (bcStrings (6 "0.0" a74 F)) + (bcStrings (6 "0.0" a75 F)) + (bcStrings (6 "1.0" a76 F)) + (bcStrings (6 "2.0" a77 F)) + (bcStrings (6 "1.0" a78 F)) + (bcStrings (6 "0.0" a79 F)) + (bcStrings (6 "0.0" a710 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" a81 F)) + (bcStrings (6 "0.0" a82 F)) + (bcStrings (6 "0.0" a83 F)) + (bcStrings (6 "0.0" a84 F)) + (bcStrings (6 "0.0" a85 F)) + (bcStrings (6 "0.0" a86 F)) + (bcStrings (6 "1.0" a87 F)) + (bcStrings (6 "2.0" a88 F)) + (bcStrings (6 "1.0" a89 F)) + (bcStrings (6 "0.0" a810 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" a91 F)) + (bcStrings (6 "0.0" a92 F)) + (bcStrings (6 "0.0" a93 F)) + (bcStrings (6 "0.0" a94 F)) + (bcStrings (6 "0.0" a95 F)) + (bcStrings (6 "0.0" a96 F)) + (bcStrings (6 "0.0" a97 F)) + (bcStrings (6 "1.0" a98 F)) + (bcStrings (6 "2.0" a99 F)) + (bcStrings (6 "1.0" a910 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "3.0" a101 F)) + (bcStrings (6 "0.0" a102 F)) + (bcStrings (6 "0.0" a103 F)) + (bcStrings (6 "0.0" a104 F)) + (bcStrings (6 "0.0" a105 F)) + (bcStrings (6 "0.0" a106 F)) + (bcStrings (6 "0.0" a107 F)) + (bcStrings (6 "0.0" a108 F)) + (bcStrings (6 "1.0" a109 F)) + (bcStrings (6 "2.0" a1010 F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Enter the matrix {\it m}: ") + (text . "\newline \tab{2} ") + (bcStrings (6 "2.0" m11 F)) + (bcStrings (6 "1.0" m12 F)) + (bcStrings (6 "0.0" m13 F)) + (bcStrings (6 "0.0" m14 F)) + (bcStrings (6 "0.0" m15 F)) + (bcStrings (6 "0.0" m16 F)) + (bcStrings (6 "0.0" m17 F)) + (bcStrings (6 "0.0" m18 F)) + (bcStrings (6 "0.0" m19 F)) + (bcStrings (6 "0.0" m110 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "1.0" m21 F)) + (bcStrings (6 "2.0" m22 F)) + (bcStrings (6 "1.0" m23 F)) + (bcStrings (6 "0.0" m24 F)) + (bcStrings (6 "0.0" m25 F)) + (bcStrings (6 "0.0" m26 F)) + (bcStrings (6 "0.0" m27 F)) + (bcStrings (6 "0.0" m28 F)) + (bcStrings (6 "0.0" m29 F)) + (bcStrings (6 "0.0" m210 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" m31 F)) + (bcStrings (6 "1.0" m32 F)) + (bcStrings (6 "2.0" m33 F)) + (bcStrings (6 "1.0" m34 F)) + (bcStrings (6 "0.0" m35 F)) + (bcStrings (6 "0.0" m36 F)) + (bcStrings (6 "0.0" m37 F)) + (bcStrings (6 "0.0" m38 F)) + (bcStrings (6 "0.0" m39 F)) + (bcStrings (6 "0.0" m310 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" m41 F)) + (bcStrings (6 "0.0" m42 F)) + (bcStrings (6 "1.0" m43 F)) + (bcStrings (6 "2.0" m44 F)) + (bcStrings (6 "1.0" m45 F)) + (bcStrings (6 "0.0" m46 F)) + (bcStrings (6 "0.0" m47 F)) + (bcStrings (6 "0.0" m48 F)) + (bcStrings (6 "0.0" m49 F)) + (bcStrings (6 "0.0" m410 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" m51 F)) + (bcStrings (6 "0.0" m52 F)) + (bcStrings (6 "0.0" m53 F)) + (bcStrings (6 "1.0" m54 F)) + (bcStrings (6 "2.0" m55 F)) + (bcStrings (6 "1.0" m56 F)) + (bcStrings (6 "0.0" m57 F)) + (bcStrings (6 "0.0" m58 F)) + (bcStrings (6 "0.0" m59 F)) + (bcStrings (6 "0.0" m510 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" m61 F)) + (bcStrings (6 "0.0" m62 F)) + (bcStrings (6 "0.0" m63 F)) + (bcStrings (6 "0.0" m64 F)) + (bcStrings (6 "1.0" m65 F)) + (bcStrings (6 "2.0" m66 F)) + (bcStrings (6 "1.0" m67 F)) + (bcStrings (6 "0.0" m68 F)) + (bcStrings (6 "0.0" m69 F)) + (bcStrings (6 "0.0" m610 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" m71 F)) + (bcStrings (6 "0.0" m72 F)) + (bcStrings (6 "0.0" m73 F)) + (bcStrings (6 "0.0" m74 F)) + (bcStrings (6 "0.0" m75 F)) + (bcStrings (6 "1.0" m76 F)) + (bcStrings (6 "2.0" m77 F)) + (bcStrings (6 "1.0" m78 F)) + (bcStrings (6 "0.0" m79 F)) + (bcStrings (6 "0.0" m710 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" m81 F)) + (bcStrings (6 "0.0" m82 F)) + (bcStrings (6 "0.0" m83 F)) + (bcStrings (6 "0.0" m84 F)) + (bcStrings (6 "0.0" m85 F)) + (bcStrings (6 "0.0" m86 F)) + (bcStrings (6 "1.0" m87 F)) + (bcStrings (6 "2.0" m88 F)) + (bcStrings (6 "1.0" m89 F)) + (bcStrings (6 "0.0" m810 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" m91 F)) + (bcStrings (6 "0.0" m92 F)) + (bcStrings (6 "0.0" m93 F)) + (bcStrings (6 "0.0" m94 F)) + (bcStrings (6 "0.0" m95 F)) + (bcStrings (6 "0.0" m96 F)) + (bcStrings (6 "0.0" m97 F)) + (bcStrings (6 "1.0" m98 F)) + (bcStrings (6 "2.0" m99 F)) + (bcStrings (6 "1.0" m910 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" m101 F)) + (bcStrings (6 "0.0" m102 F)) + (bcStrings (6 "0.0" m103 F)) + (bcStrings (6 "0.0" m104 F)) + (bcStrings (6 "0.0" m105 F)) + (bcStrings (6 "0.0" m106 F)) + (bcStrings (6 "0.0" m107 F)) + (bcStrings (6 "0.0" m108 F)) + (bcStrings (6 "1.0" m109 F)) + (bcStrings (6 "2.0" m1010 F)) + (text . "\blankline ")) + htMakeDoneButton('"Continue",'f04mbfGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'precon,precon) + htpSetProperty(page,'shift,shift) + htpSetProperty(page,'rtol,rtol) + htpSetProperty(page,'itnlim,itnlim) + htpSetProperty(page,'msglvl,msglvl) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +f04mbfGen htPage == + n := htpProperty(htPage,'n) + precon := htpProperty(htPage,'precon) + shift := htpProperty(htPage,'shift) + rtol := htpProperty(htPage,'rtol) + itnlim := htpProperty(htPage,'itnlim) + msglvl := htpProperty(htPage,'msglvl) + ifail := htpProperty(htPage,'ifail) + lrwork := '1 + liwork := '1 + alist := htpInputAreaAlist htPage + y := alist + if (precon = 'true) then + for i in 1..n repeat + for j in 1..n repeat + melm := STRCONC((first y).1," ") + mrowlist := [melm,:mrowlist] + y := rest y + matm := [mrowlist,:matm] + mrowlist := [] + mstring := bcwords2liststring [bcwords2liststring x for x in matm] + for k in 1..n repeat + for l in 1..n repeat + aelm := STRCONC((first y).1," ") + arowlist := [aelm,:arowlist] + y := rest y + mata := [arowlist,:mata] + arowlist := [] + astring := bcwords2liststring [bcwords2liststring y for y in mata] + for z in 1..n repeat + belm := STRCONC((first y).1," ") + blist := [belm,:blist] + y := rest y + bstring := bcwords2liststring blist + if (precon = 'false) then + mstring := astring + prefix := STRCONC('"f04mbf(",STRINGIMAGE n,",[",bstring,"]::Matrix DoubleFloat,",precon,",") + prefix := STRCONC(prefix,STRINGIMAGE shift,",",STRINGIMAGE itnlim,",",STRINGIMAGE msglvl,",") + prefix := STRCONC(prefix,STRINGIMAGE lrwork,",",STRINGIMAGE liwork,",") + prefix := STRCONC(prefix,STRINGIMAGE rtol,",",STRINGIMAGE ifail,",((") + prefix := STRCONC(prefix,astring,"::Matrix MachineFloat)::ASP28(APROD)),((") + prefix := STRCONC(prefix,mstring,"::Matrix MachineFloat)::ASP34(MSOLVE)))") + linkGen prefix + + +-- f04qaf() == +-- htInitPage('"F04QAF - Solution of sparse unsymmetric equations, linear and damped least-squares problems using a Lanczos algorithm",nil) +-- htMakePage '( +-- (domainConditions +-- (isDomain EM $EmptyMode) +-- (isDomain F (Float))) +-- (text . "\windowlink{Manual Page}{manpageXXf04qaf} for this routine ") +-- (text . "\newline ") +-- (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04qaf| '|NagLinearEquationSolvingPackage|)} for this routine") +-- (text . "\newline \horizontalline ") +-- (text . "\newline ") +-- (text . "F04QAF solves sparse unsymmetric equations, sparse linear ") +-- (text . "least-squares problems and sparse damped least-squares ") +-- (text . "problems, using a Lanczos algorithm. Specifically, the ") +-- (text . "routine can be used to solve a system of linear equations ") +-- (text . "{\it Ax=b}, where {\it A} is an {\it n} by {\it n} real ") +-- (text . "sparse unsymmetric matrix, or can be used to solve linear ") +-- (text . "least-squares problems, so that it minimizes the the value ") +-- (text . "{\htbitmap{newrho}} given by {\htbitmap{rho=r}}, ") +-- (text . "{\it r=b-AX} where {\it A} is an {\it m} by {\it n} real ") +-- (text . "sparse matrix. A damping parameter \lambda may ") +-- (text . "be included in the least squares problem in which case the ") +-- (text . "routine minimizes the value {\htbitmap{newrho}} given by ") +-- (text . "{\htbitmap{rhosq=}}. \newline ") +-- (text . "\blankline ") +-- (text . "\menuitemstyle{}\tab{2}") +-- (text . "\spadcommand{)read f04qaf \bound{s0}} ")) +-- htShowPage() + +-- f04mbf() == +-- htInitPage('"F04MBF - Real sparse symmetric simultaneous linear equations",nil) +-- htMakePage '( +-- (domainConditions +-- (isDomain EM $EmptyMode) +-- (isDomain F (Float))) +-- (text . "\windowlink{Manual Page}{manpageXXf04mbf} for this routine ") +-- (text . "\newline ") +-- (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04mbf| '|NagLinearEquationSolvingPackage|)} for this routine") +-- (text . "\newline \horizontalline ") +-- (text . "\newline ") +-- (text . "\newline ") +-- (text . "F04MBF solve a system of real symmetric linear equations ") +-- (text . "({\it A} - \lambda {\it I}){\it x} = {\it b} using a Lanczos ") +-- (text . "algorithm, where {\it A} is an {\it n} by {\it n} sparse ") +-- (text . "symmetric matrix, {\it x} is an {\it n} vector of unknowns ") +-- (text . "and {\it b} is an {\it n} element right-hand side vector. ") +-- (text . "\blankline") +-- (text . "\newline ") +-- (text . "\menuitemstyle{}\tab{2} ") +-- (text . "\spadcommand{)read f04mbf \bound{s0}} ")) +-- htShowPage() + +f04qaf() == + htInitPage('"F04QAF - Solution of sparse unsymmetric equations, linear and damped least-squares problems using a Lanczos algorithm",nil) + htMakePage '( + (domainConditions + (isDomain EM $EmptyMode) + (isDomain PI (PositiveInteger)) + (isDomain F (Float))) + (text . "\windowlink{Manual Page}{manpageXXf04qaf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04qaf| '|NagLinearEquationSolvingPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\newline ") + (text . "F04QAF solves sparse unsymmetric equations, sparse linear ") + (text . "least-squares problems and sparse damped least-squares ") + (text . "problems, using a Lanczos algorithm. Specifically, the ") + (text . "routine can be used to solve a system of linear equations ") + (text . "{\it Ax=b}, where {\it A} is an {\it n} by {\it n} real ") + (text . "sparse unsymmetric matrix, or can be used to solve linear ") + (text . "least-squares problems, so that it minimizes the the value ") + (text . "{\htbitmap{newrho}} given by {\htbitmap{rho=r}}, ") + (text . "{\it r=b-AX} where {\it A} is an {\it m} by {\it n} real ") + (text . "sparse matrix. A damping parameter \lambda may ") + (text . "be included in the least squares problem in which case the ") + (text . "routine minimizes the value {\htbitmap{newrho}} given by ") + (text . "{\htbitmap{rhosq=}}. \newline ") + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the number of rows of the matrix {\it A}, {\it m}:") + (text . "\newline \tab{2}") + (bcStrings (10 13 m PI)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the number of columns of the matrix {\it A}, {\it n}:") + (text . "\newline \tab{2}") + (bcStrings (10 12 n PI)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the damping parameter \lambda, {\it damp}:") + (text . "\newline \tab{2}") + (bcStrings (10 "0.0" damp F)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the tolerance for elements of {\it A}, {\it atol}:") + (text . "\newline \tab{2}") + (bcStrings (10 "0.00001" atol F)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the tolerance for elements of {\it b}, {\it btol}:") + (text . "\newline \tab{2}") + (bcStrings (10 "0.0001" btol F)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the maximum number of iterations {\it itnlim}:") + (text . "\newline \tab{2}") + (bcStrings (10 100 itnlim PI)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the printing level {\it msglvl}:") + (text . "\newline \tab{2}") + (bcStrings (10 1 msglvl PI)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Ifail value: ") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 'f04qafSolve) + htShowPage() + +f04qafSolve htPage == + m := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) + objValUnwrap htpLabelSpadValue(htPage, 'm) + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + damp := htpLabelInputString(htPage,'damp) + atol := htpLabelInputString(htPage,'atol) + btol := htpLabelInputString(htPage,'btol) + itnlim := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'itnlim) + objValUnwrap htpLabelSpadValue(htPage, 'itnlim) + msglvl := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'msglvl) + objValUnwrap htpLabelSpadValue(htPage, 'msglvl) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => '1 + '-1 + (m = '13 and n = '12) => f04qafDefaultSolve(htPage,damp,atol,btol,itnlim,msglvl,ifail) + bmatList := + "append"/[f(i) for i in 1..m] where f(i) == + bnam := INTERN STRCONC ('"b",STRINGIMAGE i) + [['bcStrings,[6, "0.0", bnam, 'F]]] + amatList := + "append"/[h(ia,n) for ia in 1..m] where h(ia,n) == + alabelList := + "append"/[k(ia,ja) for ja in 1..n] where k(ia,ja) == + anam := INTERN STRCONC ('"a",STRINGIMAGE ia,STRINGIMAGE ja) + [['bcStrings,[6, "0.0", anam, 'F]]] + prefix := ('"\newline \tab{2} ") + alabelList := [['text,:prefix],:alabelList] + start := ('"\blankline \menuitemstyle{}\tab{2} Enter the matrix {\it A}: ") + amatList := [['text,:start],:amatList] + equationPart := [ + '(domainConditions + (isDomain P (Polynomial $EmptyMode)) + (isDomain F (Float))), + :bmatList,:amatList] + page := htInitPage('"F04QAF - Solution of sparse unsymmetric equations, linear and damped least-squares problems using a Lanczos algorithm",nil) + htSay '"\newline \menuitemstyle{}\tab{2} " + htSay '"Enter the right-hand side vector {\it b(m)}: " + htSay '"\newline \tab{2} " + htMakePage equationPart + htSay '"\blankline " + htMakeDoneButton('"Continue",'f04qafGen) + htpSetProperty(page,'m,m) + htpSetProperty(page,'n,n) + htpSetProperty(page,'damp,damp) + htpSetProperty(page,'atol,atol) + htpSetProperty(page,'btol,btol) + htpSetProperty(page,'itnlim,itnlim) + htpSetProperty(page,'msglvl,msglvl) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + + + +f04qafDefaultSolve (htPage,damp,atol,btol,itnlim,msglvl,ifail) == + m := '13 + n := '12 + page := htInitPage('"F04QAF - Solution of sparse unsymmetric equations, linear and damped least-squares problems using a Lanczos algorithm",nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Enter the right-hand side vector {\it b(n)}: ") + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" b1 F)) + (bcStrings (6 "0.0" b2 F)) + (bcStrings (6 "0.0" b3 F)) + (bcStrings (6 "-0.01" b4 F)) + (bcStrings (6 "-0.01" b5 F)) + (bcStrings (6 "0.0" b6 F)) + (bcStrings (6 "0.0" b7 F)) + (bcStrings (6 "-0.01" b8 F)) + (bcStrings (6 "-0.01" b9 F)) + (bcStrings (6 "0.0" b10 F)) + (bcStrings (6 "0.0" b11 F)) + (bcStrings (6 "0.0" b12 F)) + (bcStrings (6 "10.0" b13 F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2} ") + (text . "Enter the matrix {\it A}: ") + (text . "\newline \tab{2} ") + (bcStrings (6 "1.0" a0101 F)) + (bcStrings (6 "0.0" a0102 F)) + (bcStrings (6 "0.0" a0103 F)) + (bcStrings (6 "-1.0" a0104 F)) + (bcStrings (6 "0.0" a0105 F)) + (bcStrings (6 "0.0" a0106 F)) + (bcStrings (6 "0.0" a0107 F)) + (bcStrings (6 "0.0" a0108 F)) + (bcStrings (6 "0.0" a0109 F)) + (bcStrings (6 "0.0" a0110 F)) + (bcStrings (6 "0.0" a0111 F)) + (bcStrings (6 "0.0" a0112 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" a0201 F)) + (bcStrings (6 "1.0" a0202 F)) + (bcStrings (6 "0.0" a0203 F)) + (bcStrings (6 "0.0" a0204 F)) + (bcStrings (6 "-1.0" a0205 F)) + (bcStrings (6 "0.0" a0206 F)) + (bcStrings (6 "0.0" a0207 F)) + (bcStrings (6 "0.0" a0208 F)) + (bcStrings (6 "0.0" a0209 F)) + (bcStrings (6 "0.0" a0210 F)) + (bcStrings (6 "0.0" a0211 F)) + (bcStrings (6 "0.0" a0212 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" a0301 F)) + (bcStrings (6 "0.0" a0302 F)) + (bcStrings (6 "1.0" a0303 F)) + (bcStrings (6 "-1.0" a0304 F)) + (bcStrings (6 "0.0" a0305 F)) + (bcStrings (6 "0.0" a0306 F)) + (bcStrings (6 "0.0" a0307 F)) + (bcStrings (6 "0.0" a0308 F)) + (bcStrings (6 "0.0" a0309 F)) + (bcStrings (6 "0.0" a0310 F)) + (bcStrings (6 "0.0" a0311 F)) + (bcStrings (6 "0.0" a0312 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "-1.0" a0401 F)) + (bcStrings (6 "0.0" a0402 F)) + (bcStrings (6 "-1.0" a0403 F)) + (bcStrings (6 "4.0" a0404 F)) + (bcStrings (6 "-1.0" a0405 F)) + (bcStrings (6 "0.0" a0406 F)) + (bcStrings (6 "0.0" a0407 F)) + (bcStrings (6 "-1.0" a0408 F)) + (bcStrings (6 "0.0" a0409 F)) + (bcStrings (6 "0.0" a0410 F)) + (bcStrings (6 "0.0" a0411 F)) + (bcStrings (6 "0.0" a0412 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" a0501 F)) + (bcStrings (6 "-1.0" a0502 F)) + (bcStrings (6 "0.0" a0503 F)) + (bcStrings (6 "-1.0" a0504 F)) + (bcStrings (6 "4.0" a0505 F)) + (bcStrings (6 "-1.0" a0506 F)) + (bcStrings (6 "0.0" a0507 F)) + (bcStrings (6 "0.0" a0508 F)) + (bcStrings (6 "-1.0" a0509 F)) + (bcStrings (6 "0.0" a0510 F)) + (bcStrings (6 "0.0" a0511 F)) + (bcStrings (6 "0.0" a0512 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" a0601 F)) + (bcStrings (6 "0.0" a0602 F)) + (bcStrings (6 "0.0" a0603 F)) + (bcStrings (6 "0.0" a0604 F)) + (bcStrings (6 "-1.0" a0605 F)) + (bcStrings (6 "1.0" a0606 F)) + (bcStrings (6 "0.0" a0607 F)) + (bcStrings (6 "0.0" a0608 F)) + (bcStrings (6 "0.0" a0609 F)) + (bcStrings (6 "0.0" a0610 F)) + (bcStrings (6 "0.0" a0611 F)) + (bcStrings (6 "0.0" a0612 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" a0701 F)) + (bcStrings (6 "0.0" a0702 F)) + (bcStrings (6 "0.0" a0703 F)) + (bcStrings (6 "0.0" a0704 F)) + (bcStrings (6 "0.0" a0705 F)) + (bcStrings (6 "0.0" a0706 F)) + (bcStrings (6 "1.0" a0707 F)) + (bcStrings (6 "-1.0" a0708 F)) + (bcStrings (6 "0.0" a0709 F)) + (bcStrings (6 "0.0" a0710 F)) + (bcStrings (6 "0.0" a0711 F)) + (bcStrings (6 "0.0" a0712 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" a0801 F)) + (bcStrings (6 "0.0" a0802 F)) + (bcStrings (6 "0.0" a0803 F)) + (bcStrings (6 "-1.0" a0804 F)) + (bcStrings (6 "0.0" a0805 F)) + (bcStrings (6 "0.0" a0806 F)) + (bcStrings (6 "-1.0" a0807 F)) + (bcStrings (6 "4.0" a0808 F)) + (bcStrings (6 "-1.0" a0809 F)) + (bcStrings (6 "0.0" a0810 F)) + (bcStrings (6 "-1.0" a0811 F)) + (bcStrings (6 "0.0" a0812 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" a0901 F)) + (bcStrings (6 "0.0" a0902 F)) + (bcStrings (6 "0.0" a0903 F)) + (bcStrings (6 "0.0" a0904 F)) + (bcStrings (6 "-1.0" a0905 F)) + (bcStrings (6 "0.0" a0906 F)) + (bcStrings (6 "0.0" a0907 F)) + (bcStrings (6 "-1.0" a0908 F)) + (bcStrings (6 "4.0" a0909 F)) + (bcStrings (6 "-1.0" a0910 F)) + (bcStrings (6 "0.0" a0911 F)) + (bcStrings (6 "-1.0" a0912 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" a1001 F)) + (bcStrings (6 "0.0" a1002 F)) + (bcStrings (6 "0.0" a1003 F)) + (bcStrings (6 "0.0" a1004 F)) + (bcStrings (6 "0.0" a1005 F)) + (bcStrings (6 "0.0" a1006 F)) + (bcStrings (6 "0.0" a1007 F)) + (bcStrings (6 "0.0" a1008 F)) + (bcStrings (6 "-1.0" a1009 F)) + (bcStrings (6 "1.0" a1010 F)) + (bcStrings (6 "0.0" a1011 F)) + (bcStrings (6 "0.0" a1012 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" a1101 F)) + (bcStrings (6 "0.0" a1102 F)) + (bcStrings (6 "0.0" a1103 F)) + (bcStrings (6 "0.0" a1104 F)) + (bcStrings (6 "0.0" a1105 F)) + (bcStrings (6 "0.0" a1106 F)) + (bcStrings (6 "0.0" a1107 F)) + (bcStrings (6 "-1.0" a1108 F)) + (bcStrings (6 "0.0" a1109 F)) + (bcStrings (6 "0.0" a1110 F)) + (bcStrings (6 "1.0" a1111 F)) + (bcStrings (6 "0.0" a1112 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "0.0" a1201 F)) + (bcStrings (6 "0.0" a1202 F)) + (bcStrings (6 "0.0" a1203 F)) + (bcStrings (6 "0.0" a1204 F)) + (bcStrings (6 "0.0" a1205 F)) + (bcStrings (6 "0.0" a1206 F)) + (bcStrings (6 "0.0" a1207 F)) + (bcStrings (6 "0.0" a1208 F)) + (bcStrings (6 "-1.0" a1209 F)) + (bcStrings (6 "0.0" a1210 F)) + (bcStrings (6 "0.0" a1211 F)) + (bcStrings (6 "1.0" a1212 F)) + (text . "\newline \tab{2} ") + (bcStrings (6 "1.0" a1301 F)) + (bcStrings (6 "1.0" a1302 F)) + (bcStrings (6 "1.0" a1303 F)) + (bcStrings (6 "0.0" a1304 F)) + (bcStrings (6 "0.0" a1305 F)) + (bcStrings (6 "1.0" a1306 F)) + (bcStrings (6 "1.0" a1307 F)) + (bcStrings (6 "0.0" a1308 F)) + (bcStrings (6 "0.0" a1309 F)) + (bcStrings (6 "1.0" a1310 F)) + (bcStrings (6 "1.0" a1311 F)) + (bcStrings (6 "1.0" a1312 F)) + (text . "\blankline ")) + htMakeDoneButton('"Continue",'f04qafGen) + htpSetProperty(page,'m,m) + htpSetProperty(page,'n,n) + htpSetProperty(page,'damp,damp) + htpSetProperty(page,'atol,atol) + htpSetProperty(page,'btol,btol) + htpSetProperty(page,'itnlim,itnlim) + htpSetProperty(page,'msglvl,msglvl) + htpSetProperty(page,'ifail,ifail) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +f04qafGen htPage == + m := htpProperty(htPage,'m) + n := htpProperty(htPage,'n) + damp := htpProperty(htPage,'damp) + atol := htpProperty(htPage,'atol) + btol := htpProperty(htPage,'btol) + divisor := READ_-FROM_-STRING(atol) + if (divisor < 1.0e-7) then divisor:=1.0e-7 + conlim := 1.0/divisor + itnlim := htpProperty(htPage,'itnlim) + msglvl := htpProperty(htPage,'msglvl) + ifail := htpProperty(htPage,'ifail) + lrwork := 1 + liwork := 1 + alist := htpInputAreaAlist htPage + y := alist + for k in 1..m repeat + for l in 1..n repeat + aelm := STRCONC((first y).1," ") + arowlist := [aelm,:arowlist] + y := rest y + mata := [arowlist,:mata] + arowlist := [] + astring := bcwords2liststring [bcwords2liststring y for y in mata] + for z in 1..m repeat + belm := STRCONC((first y).1," ") + blist := [belm,:blist] + y := rest y + bstring := bcwords2liststring blist + prefix := STRCONC('"f04qaf(",STRINGIMAGE m,",",STRINGIMAGE n,",") + prefix := STRCONC(prefix,STRINGIMAGE damp,",") + prefix := STRCONC(prefix,STRINGIMAGE atol,",",STRINGIMAGE btol,",") + prefix := STRCONC(prefix,STRINGIMAGE conlim,",",STRINGIMAGE itnlim,",",STRINGIMAGE msglvl,",") + prefix := STRCONC(prefix,STRINGIMAGE lrwork,",",STRINGIMAGE liwork,",") + prefix := STRCONC(prefix,"[",bstring,"]::Matrix DoubleFloat,") + prefix := STRCONC(prefix,STRINGIMAGE ifail,",((",astring,"::Matrix MachineFloat)::ASP30(APROD)))") + linkGen prefix + + + + + diff --git a/src/interp/nag-f04.boot.pamphlet b/src/interp/nag-f04.boot.pamphlet deleted file mode 100644 index 37f4951d..00000000 --- a/src/interp/nag-f04.boot.pamphlet +++ /dev/null @@ -1,2333 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp nag-f04.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. - -@ -<<*>>= -<> - -)package "BOOT" - -f04adf() == - htInitPage("F04ADF - Solution of complex simultaneous linear equations, with multiple right-hand sides (Black box)",nil) - htMakePage '( - (domainConditions - (isDomain I (Integer))) - (text . "\windowlink{Manual Page}{manpageXXf04adf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04adf| '|NagLinearEquationSolvingPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "Calculates the approximate solution of a set of complex linear ") - (text . "equations {\it AX = B} using an {\it LU} factorization with ") - (text . "partial pivoting, where {\it A} is an n * n matrix, {\it X} is ") - (text . "an {\it n} by {\it m} matrix of unknowns and {\it B} is an ") - (text . "{\it n} by {\it m} matrix of right-hand sides.") - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") - (text . "{\it n} order of matrix A:") - (text . "\tab{28} \menuitemstyle{}\tab{30} ") - (text . "{\it m} number of right-hand sides \htbitmap{great=} 0 :") - (text . "\newline\tab{2} ") - (bcStrings (10 3 n I)) - (text . "\tab{30} ") - (bcStrings (10 1 m I)) --- (text . "\blankline ") --- (text . "\newline \menuitemstyle{}\tab{2} ") --- (text . "{\it IA} first dimension of A:") --- (text . "\tab{32} \menuitemstyle{}\tab{34} ") --- (text . "{\it IB} first dimension of B:") --- (text . "\newline\tab{2} ") --- (bcStrings (10 3 ia I)) --- (text . "\tab{34} ") --- (bcStrings (10 3 ib I)) --- (text . "\blankline ") --- (text . "\newline \menuitemstyle{}\tab{2} ") --- (text . "{\it IC} first dimension of C:") --- (text . "\newline\tab{2} ") --- (bcStrings (10 3 ic I)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{} \tab{2} ") - (text . "Ifail value:") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'f04adfSolve) - htShowPage() - -f04adfSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - m := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) - objValUnwrap htpLabelSpadValue(htPage, 'm) - ia := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ia) --- objValUnwrap htpLabelSpadValue(htPage, 'ia) - ib := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ib) --- objValUnwrap htpLabelSpadValue(htPage, 'ib) - ic := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ic) --- objValUnwrap htpLabelSpadValue(htPage, 'ic) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - (n = '3 and m = '1) => f04adfDefaultSolve(htPage,ifail) - matList := - "append"/[f(i,n) for i in 1..ia] where f(i,n) == - labelList := - "append"/[g(i,j) for j in 1..n] where g(i,j) == - ianam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) - [['bcStrings,[12, "0.0 + 0.0*%i", ianam, 'F]]] - prefix := ('"\newline \tab{2} ") - labelList := [['text,:prefix],:labelList] - bmatList := - "append"/[fb(i,m) for i in 1..ib] where fb(i,m) == - blabelList := - "append"/[gb(i,j) for j in 1..m] where gb(i,j) == - bnam := INTERN STRCONC ('"b",STRINGIMAGE i, STRINGIMAGE j) - [['bcStrings,[12, "0.0 + 0.0*%i", bnam, 'F]]] - prefix := ('"\newline \tab{2} ") - blabelList := [['text,:prefix],:blabelList] - start := ('"\blankline \menuitemstyle{} \tab{2} Enter values of {\it b}:") - bmatList := [['text,:start],:bmatList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain F (Float))), - :matList,:bmatList] - page := htInitPage("F04ADF - Solution of complex simultaneous linear equations, with multiple right-hand sides (Black box)",nil) - htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " - htSay '"\newline \tab{2} " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'f04adfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) --- htpSetProperty(page,'ia,ia) --- htpSetProperty(page,'ib,ib) --- htpSetProperty(page,'ic,ic) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - - -f04adfDefaultSolve (htPage, ifail) == - n := '3 - m := '1 - ia := '3 - ib := '3 - ic := '3 - page := htInitPage("F04ADF - Solution of complex simultaneous linear equations, with multiple right-hand sides (Black box)",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ") - (text . "\newline \tab{2} ") - (bcStrings (12 "1" a11 F)) - (bcStrings (12 "1 + 2*%i" a12 F)) - (bcStrings (12 "2 + 10*%i" a13 F)) - (text . "\newline \tab{2} ") - (bcStrings (12 "1 + %i" a21 F)) - (bcStrings (12 "3*%i" a22 F)) - (bcStrings (12 "-5 + 14*%i" a23 F)) - (text . "\newline \tab{2} ") - (bcStrings (12 "1 + %i" a31 F)) - (bcStrings (12 "5*%i" a32 F)) - (bcStrings (12 "-8 + 20*%i" a33 F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter values of {\it b}: ") - (text . "\newline \tab{2} ") - (bcStrings (12 "1" b1 F)) - (text . "\newline \tab{2} ") - (bcStrings (12 "0" b2 F)) - (text . "\newline \tab{2} ") - (bcStrings (12 "0" b3 F))) - htMakeDoneButton('"Continue",'f04adfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) --- htpSetProperty(page,'ia,ia) --- htpSetProperty(page,'ib,ib) --- htpSetProperty(page,'ic,ic) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f04adfGen htPage == - n := htpProperty(htPage,'n) - m := htpProperty(htPage,'m) --- ia := htpProperty(htPage,'ia) --- ib := htpProperty(htPage,'ib) --- ic := htpProperty(htPage,'ic) - ia := n - ib := n - ic := n - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - -- will probably need to change this as its a vector not an array - for i in 1..m repeat - for j in 1..ib repeat - right := STRCONC((first y).1," ") - y := rest y - bList := [right,:bList] - bstring := bcwords2liststring bList - boutList := [bstring,:boutList] - bList := [] - boutstring := bcwords2liststring boutList - y := REVERSE y - k := -1 - matform := [[y.(k := k + 1).1 for j in 0..(n-1)] for i in 0..(ia-1)] - matstring := bcwords2liststring [bcwords2liststring x for x in matform] - prefix := STRCONC('"f04adf(",STRINGIMAGE ia,",",boutstring,",") - prefix := STRCONC(prefix,STRINGIMAGE ib,", ",STRINGIMAGE n,", ") - prefix := STRCONC(prefix,STRINGIMAGE m,", ",STRINGIMAGE ic) - prefix := STRCONC(prefix,", ",matstring,", ",STRINGIMAGE ifail,")") - bcGen prefix - -f04arf() == - htInitPage("F04ARF - Solution of real simultaneous linear equations, one right-hand side (Black box)",nil) - htMakePage '( - (domainConditions - (isDomain I (Integer))) - (text . "\windowlink{Manual Page}{manpageXXf04arf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04arf| '|NagLinearEquationSolvingPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\blankline ") - (text . "Calculates the approximate solution of a set of real linear ") - (text . "equations {\it Ax = b} using an {\it LU} factorization with ") - (text . "pivoting, where {\it A} is an n * n matrix, {\it x} is an n ") - (text . "element vector of unknowns and {\it b} is an n element ") - (text . "right-hand side vector.") - (text . "\blankline ") - (text . "\newline ") - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") --- (text . "{\it IA} first dimension of A:") --- (text . "\tab{32} \menuitemstyle{}\tab{34} ") - (text . "{\it n} order of matrix A:") - (text . "\newline\tab{2} ") --- (bcStrings (10 8 ia I)) --- (text . "\tab{34} ") - (bcStrings (10 3 n I)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{} \tab{2} ") - (text . "Ifail value:") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'f04arfSolve) - htShowPage() - -f04arfSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - ia := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ia) --- objValUnwrap htpLabelSpadValue(htPage, 'ia) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - n = '3 => f04arfDefaultSolve(htPage,ifail) - matList := - "append"/[f(i,n) for i in 1..ia] where f(i,n) == - labelList := - "append"/[g(i,j) for j in 1..n] where g(i,j) == - ianam := INTERN STRCONC ('"ia",STRINGIMAGE i, STRINGIMAGE j) - [['bcStrings,[6, "0.0", ianam, 'F]]] - prefix := ('"\newline \tab{2} ") - labelList := [['text,:prefix],:labelList] - bmatList := - "append"/[h(k) for k in 1..n] where h(k) == - prefix := ('"\newline \tab{2} ") - bnam := INTERN STRCONC ('"b",STRINGIMAGE k) - [['text,:prefix],['bcStrings,[6, "0.0", bnam, 'F]]] - start := ('"\blankline \menuitemstyle{} \tab{2} Enter values of {\it b}:") - bmatList := [['text,:start],:bmatList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain F (Float))), - :matList,:bmatList] - page := htInitPage("F04ARF - Solution of real simultaneous linear equations, one right-hand side (Black box)",nil) - htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " - htSay '"\newline \tab{2} " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'f04arfGen) - htpSetProperty(page,'n,n) --- htpSetProperty(page,'ia,ia) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - - -f04arfDefaultSolve (htPage, ifail) == - n := '3 - ia := '3 - page := htInitPage("F04ARF - Solution of real simultaneous linear equations, one right-hand side (Black box)",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 33 ia11 F)) - (bcStrings (6 16 ia12 F)) - (bcStrings (6 72 ia13 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "-24" ia21 F)) - (bcStrings (6 "-10" ia22 F)) - (bcStrings (6 "-57" ia23 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "-8" ia31 F)) - (bcStrings (6 "-4" ia32 F)) - (bcStrings (6 "-17" ia33 F)) --- (text . "\newline \tab{2} ") --- (bcStrings (6 0 ia41 F)) --- (bcStrings (6 0 ia42 F)) --- (bcStrings (6 0 ia43 F)) --- (text . "\newline \tab{2} ") --- (bcStrings (6 0 ia51 F)) --- (bcStrings (6 0 ia52 F)) --- (bcStrings (6 0 ia53 F)) --- (text . "\newline \tab{2} ") --- (bcStrings (6 0 ia61 F)) --- (bcStrings (6 0 ia62 F)) --- (bcStrings (6 0 ia63 F)) --- (text . "\newline \tab{2} ") --- (bcStrings (6 0 ia71 F)) --- (bcStrings (6 0 ia72 F)) --- (bcStrings (6 0 ia73 F)) --- (text . "\newline \tab{2} ") --- (bcStrings (6 0 ia81 F)) --- (bcStrings (6 0 ia82 F)) --- (bcStrings (6 0 ia83 F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter values of {\it b}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 "-359" b1 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "281" b2 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "85" b3 F))) - htMakeDoneButton('"Continue",'f04arfGen) - htpSetProperty(page,'n,n) --- htpSetProperty(page,'ia,ia) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f04arfGen htPage == - n := htpProperty(htPage,'n) --- ia := htpProperty(htPage,'ia) - ia := n - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - for i in 1..n repeat - right := STRCONC((first y).1," ") - y := rest y - bList := [right,:bList] - bstring := bcwords2liststring bList - y := REVERSE y - k := -1 - matform := [[y.(k := k + 1).1 for j in 0..(n-1)] for i in 0..(ia-1)] - matstring := bcwords2liststring [bcwords2liststring x for x in matform] - prefix := STRCONC('"f04arf(",STRINGIMAGE ia,", [",bstring,"],",STRINGIMAGE n) - prefix := STRCONC(prefix,", ",matstring,", ",STRINGIMAGE ifail,")") - bcGen prefix - -f04asf() == - htInitPage("F04ASF - Solution of real symmetric positive-definite simultaneous linear equations, one right-hand side using iterative refinement (Black box)",nil) - htMakePage '( - (domainConditions - (isDomain I (Integer))) - (text . "\windowlink{Manual Page}{manpageXXf04asf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04asf| '|NagLinearEquationSolvingPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\blankline ") - (text . "Calculates the accurate solution of a set of real symmetric ") - (text . "positive-definite linear equations {\it Ax = b} using an a ") - (text . "Cholesky factorization and iterative refinement, ") - (text . "where {\it A} is an n * n matrix, {\it x} is an n ") - (text . "element vector of unknowns and {\it b} is an n element ") - (text . "right-hand side vector.") - (text . "\blankline ") - (text . "\newline ") - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") --- (text . "{\it IA} first dimension of A:") --- (text . "\tab{32} \menuitemstyle{}\tab{34} ") - (text . "{\it n} order of matrix A:") - (text . "\newline\tab{2} ") --- (bcStrings (10 8 ia I)) --- (text . "\tab{34} ") - (bcStrings (10 4 n I)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{} \tab{2} ") - (text . "Ifail value:") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'f04asfSolve) - htShowPage() - -f04asfSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - ia := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ia) --- objValUnwrap htpLabelSpadValue(htPage, 'ia) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 --- (n = '4 and ia = '8) => f04asfDefaultSolve(htPage,ifail) - n = '4 => f04asfDefaultSolve(htPage,ifail) - matList := - "append"/[f(i,n) for i in 1..ia] where f(i,n) == - labelList := - "append"/[g(i,j) for j in 1..n] where g(i,j) == - ianam := INTERN STRCONC ('"ia",STRINGIMAGE i, STRINGIMAGE j) - [['bcStrings,[6, "0.0", ianam, 'F]]] - prefix := ('"\newline \tab{2} ") - labelList := [['text,:prefix],:labelList] - bmatList := - "append"/[h(k) for k in 1..n] where h(k) == - prefix := ('"\newline \tab{2} ") - bnam := INTERN STRCONC ('"b",STRINGIMAGE k) - [['text,:prefix],['bcStrings,[6, "0.0", bnam, 'F]]] - start := ('"\blankline \menuitemstyle{} \tab{2} Enter values of {\it b}:") - bmatList := [['text,:start],:bmatList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain F (Float))), - :matList,:bmatList] - page := htInitPage("F04ASF - Solution of real symmetric positive-definite simultaneous linear equations, one right-hand side using iterative refinement (Black box)",nil) - htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " - htSay '"\newline \tab{2} " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'f04asfGen) - htpSetProperty(page,'n,n) --- htpSetProperty(page,'ia,ia) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - - -f04asfDefaultSolve (htPage, ifail) == - n := '4 - ia := '4 - page := htInitPage("F04ASF - Solution of real symmetric positive-definite simultaneous linear equations, one right-hand side using iterative refinement (Black box)",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 5 ia11 F)) - (bcStrings (6 7 ia12 F)) - (bcStrings (6 6 ia13 F)) - (bcStrings (6 5 ia14 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 7 ia21 F)) - (bcStrings (6 10 ia22 F)) - (bcStrings (6 8 ia23 F)) - (bcStrings (6 7 ia24 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 6 ia31 F)) - (bcStrings (6 8 ia32 F)) - (bcStrings (6 10 ia33 F)) - (bcStrings (6 9 ia34 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 5 ia41 F)) - (bcStrings (6 7 ia42 F)) - (bcStrings (6 9 ia43 F)) - (bcStrings (6 10 ia44 F)) --- (text . "\newline \tab{2} ") --- (bcStrings (6 0 ia51 F)) --- (bcStrings (6 0 ia52 F)) --- (bcStrings (6 0 ia53 F)) --- (bcStrings (6 0 ia54 F)) --- (text . "\newline \tab{2} ") --- (bcStrings (6 0 ia61 F)) --- (bcStrings (6 0 ia62 F)) --- (bcStrings (6 0 ia63 F)) --- (bcStrings (6 0 ia64 F)) --- (text . "\newline \tab{2} ") --- (bcStrings (6 0 ia71 F)) --- (bcStrings (6 0 ia72 F)) --- (bcStrings (6 0 ia73 F)) --- (bcStrings (6 0 ia74 F)) --- (text . "\newline \tab{2} ") --- (bcStrings (6 0 ia81 F)) --- (bcStrings (6 0 ia82 F)) --- (bcStrings (6 0 ia83 F)) --- (bcStrings (6 0 ia84 F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter values of {\it b}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 23 b1 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 32 b2 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 33 b3 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 31 b4 F))) - htMakeDoneButton('"Continue",'f04asfGen) - htpSetProperty(page,'n,n) --- htpSetProperty(page,'ia,ia) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f04asfGen htPage == - n := htpProperty(htPage,'n) --- ia := htpProperty(htPage,'ia) - ia := n - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - for i in 1..n repeat - right := STRCONC((first y).1," ") - y := rest y - bList := [right,:bList] - bstring := bcwords2liststring bList - y := REVERSE y - k := -1 - matform := [[y.(k := k + 1).1 for j in 0..(n-1)] for i in 0..(ia-1)] - matstring := bcwords2liststring [bcwords2liststring x for x in matform] - prefix := STRCONC('"f04asf(",STRINGIMAGE ia,", [",bstring,"],",STRINGIMAGE n) - prefix := STRCONC(prefix,", ",matstring,", ",STRINGIMAGE ifail,")") - bcGen prefix - -f04atf() == - htInitPage("F04ATF - Solution of real simultaneous linear equations, one right-hand side using iterative refinement (Black box)",nil) - htMakePage '( - (domainConditions - (isDomain I (Integer))) - (text . "\windowlink{Manual Page}{manpageXXf04atf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04atf| '|NagLinearEquationSolvingPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\blankline ") - (text . "Calculates the approximate solution of a set of real linear ") - (text . "equations {\it Ax = b} using an {\it LU} factorization with ") - (text . "pivoting and iterative refinement, ") - (text . "where {\it A} is an n * n matrix, {\it x} is an n ") - (text . "element vector of unknowns and {\it b} is an n element ") - (text . "right-hand side vector.") - (text . "\blankline ") - (text . "\newline ") - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") --- (text . "{\it IA} first dimension of A:") --- (text . "\tab{32} \menuitemstyle{}\tab{34} ") - (text . "{\it n} order of matrix A:") - (text . "\newline\tab{2} ") --- (bcStrings (10 8 ia I)) --- (text . "\tab{34} ") - (bcStrings (10 3 n I)) --- (text . "\blankline ") --- (text . "\newline \menuitemstyle{} \tab{2} ") --- (text . "{\it IAA} first dimension of AA:") --- (text . "\newline \tab{2} ") --- (bcStrings (10 8 iaa I)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{} \tab{2} ") - (text . "Ifail value:") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'f04atfSolve) - htShowPage() - -f04atfSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - ia := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ia) --- objValUnwrap htpLabelSpadValue(htPage, 'ia) - iaa := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iaa) --- objValUnwrap htpLabelSpadValue(htPage, 'iaa) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 --- (n = '3 and ia = '8) => f04atfDefaultSolve(htPage,iaa,ifail) - n = '3 => f04atfDefaultSolve(htPage,iaa,ifail) - matList := - "append"/[f(i,n) for i in 1..ia] where f(i,n) == - labelList := - "append"/[g(i,j) for j in 1..n] where g(i,j) == - ianam := INTERN STRCONC ('"ia",STRINGIMAGE i, STRINGIMAGE j) - [['bcStrings,[6, "0.0", ianam, 'F]]] - prefix := ('"\newline \tab{2} ") - labelList := [['text,:prefix],:labelList] - bmatList := - "append"/[h(k) for k in 1..n] where h(k) == - prefix := ('"\newline \tab{2} ") - bnam := INTERN STRCONC ('"b",STRINGIMAGE k) - [['text,:prefix],['bcStrings,[6, "0.0", bnam, 'F]]] - start := ('"\blankline \menuitemstyle{} \tab{2} Enter values of {\it b}:") - bmatList := [['text,:start],:bmatList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain F (Float))), - :matList,:bmatList] - page := htInitPage("F04ATF - Solution of real simultaneous linear equations, one right-hand side using iterative refinement (Black box)",nil) - htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " - htSay '"\newline \tab{2} " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'f04atfGen) - htpSetProperty(page,'n,n) --- htpSetProperty(page,'ia,ia) --- htpSetProperty(page,'iaa,iaa) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - - -f04atfDefaultSolve (htPage, iaa, ifail) == - n := '3 - ia := '3 - page := htInitPage("F04ATF - Solution of real simultaneous linear equations, one right-hand side using iterative refinement (Black box)",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 33 ia11 F)) - (bcStrings (6 16 ia12 F)) - (bcStrings (6 72 ia13 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "-24" ia21 F)) - (bcStrings (6 "-10" ia22 F)) - (bcStrings (6 "-57" ia23 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "-8" ia31 F)) - (bcStrings (6 "-4" ia32 F)) - (bcStrings (6 "-17" ia33 F)) --- (text . "\newline \tab{2} ") --- (bcStrings (6 0 ia41 F)) --- (bcStrings (6 0 ia42 F)) --- (bcStrings (6 0 ia43 F)) --- (text . "\newline \tab{2} ") --- (bcStrings (6 0 ia51 F)) --- (bcStrings (6 0 ia52 F)) --- (bcStrings (6 0 ia53 F)) --- (text . "\newline \tab{2} ") --- (bcStrings (6 0 ia61 F)) --- (bcStrings (6 0 ia62 F)) --- (bcStrings (6 0 ia63 F)) --- (text . "\newline \tab{2} ") --- (bcStrings (6 0 ia71 F)) --- (bcStrings (6 0 ia72 F)) --- (bcStrings (6 0 ia73 F)) --- (text . "\newline \tab{2} ") --- (bcStrings (6 0 ia81 F)) --- (bcStrings (6 0 ia82 F)) --- (bcStrings (6 0 ia83 F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter values of {\it b}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 "-359" b1 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "281" b2 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "85" b3 F))) - htMakeDoneButton('"Continue",'f04atfGen) - htpSetProperty(page,'n,n) --- htpSetProperty(page,'ia,ia) --- htpSetProperty(page,'iaa,iaa) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f04atfGen htPage == - n := htpProperty(htPage,'n) --- ia := htpProperty(htPage,'ia) --- iaa := htpProperty(htPage,'iaa) - ia := n - iaa := n - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - for i in 1..n repeat - right := STRCONC((first y).1," ") - y := rest y - bList := [right,:bList] - bstring := bcwords2liststring bList - y := REVERSE y - k := -1 - matform := [[y.(k := k + 1).1 for j in 0..(n-1)] for i in 0..(ia-1)] - matstring := bcwords2liststring [bcwords2liststring x for x in matform] - prefix := STRCONC('"f04atf(",matstring,", ",STRINGIMAGE ia,", [",bstring) - prefix := STRCONC(prefix,"],",STRINGIMAGE n,", ",STRINGIMAGE iaa,", ") - prefix := STRCONC(prefix,STRINGIMAGE ifail,")") - bcGen prefix - - -f04faf() == - htInitPage('"F04FAF - Solution of real symmetric positive-definite tridiagonal simultaneous linear equations, one right-hand side (Black box)",nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXf04adf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04faf| '|NagLinearEquationSolvingPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\blankline ") - (text . "Calculates the approximate solution of a set of real symmetric ") - (text . "positive-definite tridiagonal linear equations {\it Tx = b} ") - (text . "using a modified symmetric Gaussian Elimination algorithm, ") - (text . "where {\it T} is an n * n matrix, {\it x} is an n ") - (text . "element vector of unknowns and {\it b} is an n element ") - (text . "right-hand side vector. {\it T} is factorized as ") - (text . "\inputbitmap{\htbmdir{}/mkm.bitmap}, where {\it K} is a diagonal matrix ") - (text . "and {\it M} is a matrix of multipliers. ") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "{\it JOB} to be performed by f04faf: ") - (radioButtons job - ("" " = 0. {\it T} is factorized and equations {\it Tx = b} are solved for x." jobZero) - ("" " = 1. {\it T} assumed to be already factorized by previous call to f04faf, the equations {\it Tx = b} are solved for x." jobOne)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "\newline Order of the matrix T {\it n}:") - (text . "\newline \tab{2} ") - (bcStrings (6 5 n PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'f04fafSolve) - htShowPage() - -f04fafSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - number := htpButtonValue(htPage,'job) - job := - number = 'jobOne => '1 - '0 - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - n = '5 => f04fafDefaultSolve(htPage,job,ifail) - dList := - "append"/[f(i) for i in 1..n] where f(i) == - prefix := ('"\newline \tab{2} ") - dnam := INTERN STRCONC ('"d",STRINGIMAGE i) - [['text,:prefix],['bcStrings,[10, 0.0, dnam, 'F]]] - prefix := ('"\menuitemstyle{}\tab{2} {\it D} Diagonal elements of T: ") - prefix := STRCONC(prefix,"\newline \tab{2} ") - dList := [['text,:prefix],:dList] - eList := - "append"/[g(j) for j in 1..(n-1)] where g(j) == - prefix := ('"\newline \tab{2} ") - enam := INTERN STRCONC ('"e",STRINGIMAGE j) - [['text,:prefix],['bcStrings,[10, 0.0, enam, 'F]]] - prefix := ('"\blankline \newline \menuitemstyle{}\tab{2} {\it E} E(2) ") - prefix := STRCONC(prefix,"to E(N)\newline \tab{2} Job = 0 => super-diagonal") - prefix := STRCONC(prefix," elements of {\it T}. \newline \tab{2} Job = 1 =>") - prefix := STRCONC(prefix," off-diagonal elements of {\it M} from previous ") - prefix := STRCONC(prefix,"call to F04FAF. ") - eList := [['text,:prefix],:eList] - bList := - "append"/[h(k) for k in 1..n] where h(k) == - prefix := ('"\newline \tab{2} ") - bnam := INTERN STRCONC ('"b",STRINGIMAGE k) - [['text,:prefix],['bcStrings,[10, 0.0, bnam, 'F]]] - prefix := ('"\blankline \newline \menuitemstyle{}\tab{2} {\it B} Right-hand") - prefix := STRCONC(prefix," side vector b: ") - bList := [['text,:prefix],:bList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :dList,:eList,:bList] - page := htInitPage("F04FAF - Solution of real symmetric positive-definite tridiagonal simultaneous linear equations, one right-hand side (Black box)",nil) - htMakePage equationPart - htMakeDoneButton('"Continue",'f04fafGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'job,job) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -f04fafDefaultSolve (htPage,job,ifail) == - n := '5 - page := htInitPage('"F04FAF - Solution of real symmetric positive-definite tridiagonal simultaneous linear equations, one right-hand side (Black box)",nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} {\it D} Diagonal elements of T:") - (text . "\newline \tab{2} ") - (bcStrings (10 4 d1 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 10 d2 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 29 d3 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 25 d4 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 5 d5 F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} {\it E}\space{1} E(2) to E(N) ") - (text . "\newline \tab{2} ") - (text . "Job = 0 => super-diagonal elements of {\it T}. \newline \tab{2}") - (text . "Job = 1 => off-diagonal elements of {\it M} from ") - (text . "previous call to F04FAF \newline \tab{2} ") - (bcStrings (10 "-2" e2 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "-6" e3 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 15 e4 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 8 e5 F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} {\it B} Right-hand side vector b:") - (text . "\newline \tab{2} ") - (bcStrings (10 6 b1 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 9 b2 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 2 b3 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 14 b4 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 7 b5 F))) - htMakeDoneButton('"Continue",'f04fafGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'job,job) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f04fafGen htPage == - n := htpProperty(htPage,'n) - job := htpProperty(htPage,'job) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - for i in 1..n repeat - b := STRCONC((first y).1," ") - bList := [b,:bList] - y := rest y - bstring := bcwords2liststring bList - for i in 1..(n-1) repeat - e := STRCONC((first y).1," ") - eList := [e,:eList] - y := rest y - eList := ['"0",:eList] - estring := bcwords2liststring eList - for i in 1..n repeat - d := STRCONC((first y).1," ") - dList := [d,:dList] - y := rest y - dstring := bcwords2liststring dList - prefix := STRCONC('"f04faf(",STRINGIMAGE job,", ",STRINGIMAGE n,",[") - prefix := STRCONC(prefix,dstring,"], [",estring,"], [",bstring,"], ") - prefix := STRCONC(prefix,STRINGIMAGE ifail,")") - bcGen prefix - - -f04jgf() == - htInitPage('"F04JGF - Least-squares (if rank = n) or minimal least-squares (if rank < n) solution of m real equations in n unknowns, rank \inputbitmap{\htbmdir{}/less=.bitmap} it n, m \inputbitmap{\htbmdir{}/great=.bitmap} n",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXf04jgf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04jgf| '|NagLinearEquationSolvingPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\blankline ") - (text . "Finds the solution of a linear least squares problem {\it Ax=b},") - (text . " where A is a real m by n matrix, (m \inputbitmap{\htbmdir{}/great=.bitmap}") - (text . " n), x is an n element vector of unknowns and b is an m element ") - (text . "right-hand side vector. The routine uses a QU factorization if ") - (text . "rank A = n and the SVD if A < n. ") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline Rows of matrix A, {\it m}: ") - (text . "\tab{32} \menuitemstyle{} \tab{34} ") - (text . "Columns of matrix A, {\it n}: \newline \tab{2} ") - (bcStrings (6 6 m PI)) - (text . "\tab{34} ") - (bcStrings (6 4 n PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") --- (text . "\newline First dimension of A, {\it nra}: ") --- (text . "\tab{32} \menuitemstyle{} \tab{34} ") - (text . "Tolerance, {\it tol}: ") - (text . "\newline \tab{2} ") --- (bcStrings (6 8 nra PI)) --- (text . "\tab{34} ") - (bcStrings (8 "5.0e-4" tol F)) --- (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{}\tab{2}") --- (text . "\newline Dimension of workspace array {\it lwork}: ") --- (text . "\newline \tab{2} ") --- (bcStrings (6 32 lwork PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'f04jgfSolve) - htShowPage() - -f04jgfSolve htPage == - m := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) - objValUnwrap htpLabelSpadValue(htPage, 'm) - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - nra := m --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nra) --- objValUnwrap htpLabelSpadValue(htPage, 'nra) - lwork := 4*n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lwork) --- objValUnwrap htpLabelSpadValue(htPage, 'lwork) - tol := htpLabelInputString(htPage,'tol) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - (m = '6 and n = '4) => f04jgfDefaultSolve(htPage,nra,lwork,tol,ifail) - matList := - "append"/[f(i,n) for i in 1..m] where f(i,n) == - labelList := - "append"/[g(i,j) for j in 1..n] where g(i,j) == - anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) - [['bcStrings,[6, "0.0", anam, 'F]]] - prefix := ('"\newline \tab{2} ") - labelList := [['text,:prefix],:labelList] - bmatList := - "append"/[h(k) for k in 1..m] where h(k) == - prefix := ('"\newline \tab{2} ") - bnam := INTERN STRCONC ('"b",STRINGIMAGE k) - [['text,:prefix],['bcStrings,[6, "0.0", bnam, 'F]]] - start := ('"\blankline \menuitemstyle{} \tab{2} Enter values of {\it b}:") - bmatList := [['text,:start],:bmatList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :matList,:bmatList] - page := htInitPage("F04JGF - Least-squares (if rank = {\it n}) or minimal least-squares (if rank < {\it n}) solution of {\it m} real equations in {\it n} unknowns, rank \inputbitmap{\htbmdir{}/less=.bitmap} {\it n}, {\it m} \inputbitmap{\htbmdir{}/great=.bitmap} {\it n}",nil) - htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " - htSay '"\newline \tab{2} " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'f04jgfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) --- htpSetProperty(page,'nra,nra) --- htpSetProperty(page,'lwork,lwork) - htpSetProperty(page,'tol,tol) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -f04jgfDefaultSolve (htPage,nra,lwork,tol,ifail) == - n := '4 - m := '6 - page := htInitPage('"F04JGF - Least-squares (if rank = n) or minimal least-squares (if rank < n) solution of m real equations in n unknowns, rank \inputbitmap{\htbmdir{}/less=.bitmap} n, m \inputbitmap{\htbmdir{}/great=.bitmap} n",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 "0.05" a11 F)) - (bcStrings (6 "0.05" a12 F)) - (bcStrings (6 "0.25" a13 F)) - (bcStrings (6 "-0.25" a14 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.25" a21 F)) - (bcStrings (6 "0.25" a22 F)) - (bcStrings (6 "0.05" a23 F)) - (bcStrings (6 "-0.05" a24 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.35" a31 F)) - (bcStrings (6 "0.35" a32 F)) - (bcStrings (6 "1.75" a33 F)) - (bcStrings (6 "-1.75" a34 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "1.75" a41 F)) - (bcStrings (6 "1.75" a42 F)) - (bcStrings (6 "0.35" a43 F)) - (bcStrings (6 "-0.35" a44 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.30" a51 F)) - (bcStrings (6 "-0.30" a52 F)) - (bcStrings (6 "0.30" a53 F)) - (bcStrings (6 "0.30" a54 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.40" a61 F)) - (bcStrings (6 "-0.40" a62 F)) - (bcStrings (6 "0.40" a63 F)) - (bcStrings (6 "0.40" a64 F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter values of {\it b}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 1 b1 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 2 b2 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 3 b3 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 4 b4 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 5 b5 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 6 b6 F))) - htMakeDoneButton('"Continue",'f04jgfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) --- htpSetProperty(page,'nra,nra) --- htpSetProperty(page,'lwork,lwork) - htpSetProperty(page,'tol,tol) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f04jgfGen htPage == - n := htpProperty(htPage,'n) - m := htpProperty(htPage,'m) --- nra := htpProperty(htPage,'nra) --- lwork := htpProperty(htPage,'lwork) - nra := m - lwork := 4*n - tol := htpProperty(htPage,'tol) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - for i in 1..m repeat - b := STRCONC((first y).1," ") - bList := [b,:bList] - y := rest y - bstring := bcwords2liststring bList - y := REVERSE y - for i in 1..m repeat - for j in 1..n repeat - elm := STRCONC((first y).1," ") - rowList := [:rowList,elm] - y := rest y - matform := [:matform,rowList] - rowList := [] - for i in 1..n repeat - null := STRCONC('"0.0"," ") - nullList := [:nullList,null] - for i in m..(nra-1) repeat - matform := [:matform,nullList] - matstring := bcwords2liststring [bcwords2liststring x for x in matform] - prefix := STRCONC('"f04jgf(",STRINGIMAGE m,", ",STRINGIMAGE n,", ") - prefix := STRCONC(prefix,STRINGIMAGE nra,", ",tol,", ",STRINGIMAGE lwork) - prefix := STRCONC(prefix,", ",matstring,", [",bstring,"], ") - prefix := STRCONC(prefix,STRINGIMAGE ifail,")") - bcGen prefix - -f04mcf() == - htInitPage("F04MCF - Approximate solution of real symmetric positive-definite variable-bandwidth simultaneous linear equations (coefficient matrix already factorized)",nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXf04mcf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04mcf| '|NagLinearEquationSolvingPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "Computes the approximate solution of a system of real linear ") - (text . "equations AX = B, where the n by n symmetric positive-definite ") - (text . "variable-bandwidth matrix A has previously been factorized as ") - (text . "\htbitmap{ldlt} by F01MCF, X is an n by r matrix of unknowns ") - (text . "and B is an n by r matrix of right-hand sides. Related systems ") - (text . "may also be solved. ") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the order of the matrix A, {\it n} ") - (text ."\htbitmap{great=} 1:") - (text . "\newline\tab{2} ") - (bcStrings (9 6 n PI)) - (text . "\blankline") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "\newline Enter the dimension of AL, {\it lal}: ") - (text . "\newline\tab{2} ") - (bcStrings (9 14 lal PI)) - (text . "\blankline") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "\newline Enter the number of right-hand sides, {\it ir}: ") - (text . "\newline\tab{2} ") - (bcStrings (9 2 ir PI)) --- (text . "\blankline") --- (text . "\newline ") --- (text . "\menuitemstyle{}\tab{2}") --- (text . "\newline Enter the first dimension of B, {\it nrb}: ") --- (text . "\newline\tab{2} ") --- (bcStrings (9 6 nrb PI)) --- (text . "\blankline") --- (text . "\newline ") --- (text . "\menuitemstyle{}\tab{2}") --- (text . "\newline Enter the first dimension of X, {\it nrx}: ") --- (text . "\newline\tab{2} ") --- (bcStrings (9 6 nrx PI)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") - (text . "Type of system to be solved, {\it iselct}:") - (radioButtons iselct - ("" " {\em \htbitmap{ldlt}X = B} is solved" selone) - ("" " {\em LDX = B} is solved" seltwo) - ("" " {\em D\htbitmap{lt}X = B} is solved" selthree) - ("" " {\em L\htbitmap{lt}X = B} is solved" selfour) - ("" " {\em LX = B} is solved" selfive) - ("" " {\em \htbitmap{lt}X = B} is solved" selsix)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} Ifail value:") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'f04mcfSolve) - htShowPage() - -f04mcfSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - lal := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lal) - objValUnwrap htpLabelSpadValue(htPage, 'lal) - ir := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ir) - objValUnwrap htpLabelSpadValue(htPage, 'ir) - nrb := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nrb) --- objValUnwrap htpLabelSpadValue(htPage, 'nrb) - nrx := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nrx) --- objValUnwrap htpLabelSpadValue(htPage, 'nrx) - select := htpButtonValue(htPage,'iselct) - iselct := - select = 'selone => '1 - select = 'seltwo => '2 - select = 'selthree => '3 - select = 'selfour => '4 - select = 'selfive => '5 - '6 - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - (n = '6 and lal = '14 and ir = '2) => f04mcfDefaultSolve(htPage,iselct,ifail) - labelList := - "append"/[fal(i) for i in 1..lal] where fal(i) == - xnam := INTERN STRCONC ('"x",STRINGIMAGE i) - [['bcStrings,[6, "0.0", xnam, 'F]]] - dList := - "append"/[fd(i) for i in 1..n] where fd(i) == - dnam := INTERN STRCONC ('"d",STRINGIMAGE i) - [['bcStrings,[6, "0.0", dnam, 'F]]] - prefix := ('"\blankline \menuitemstyle{}\tab{2} Diagonal elements of diagon") - prefix := STRCONC(prefix,"al matrix D as returned by F01MCF: \newline") - dList := [['text,:prefix],:dList] - nrowList := - "append"/[gj(j) for j in 1..n] where gj(j) == - nam := INTERN STRCONC ('"n",STRINGIMAGE j) - [['bcStrings,[6, 0, nam, 'PI]]] - prefix := ('"\blankline \menuitemstyle{}\tab{2} {\it NROW(n)} the width ") - prefix := STRCONC(prefix,"of the ith row of A: \newline ") - nrowList := [['text,:prefix],:nrowList] - bList := - "append"/[f(i,ir) for i in 1..nrb] where f(i,ir) == - labelList := - "append"/[g(i,j) for j in 1..ir] where g(i,j) == - bnam := INTERN STRCONC ('"b",STRINGIMAGE i, STRINGIMAGE j) - [['bcStrings,[6, "0.0", bnam, 'F]]] - prefix := ('"\newline ") - labelList := [['text,:prefix],:labelList] - prefix := ('"\blankline \menuitemstyle{}\tab{2} The n by r right-hand side ") - prefix := STRCONC(prefix,"matrix B: \newline ") - bList := [['text,:prefix],:bList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :labelList,:dList,:nrowList,:bList] - page := htInitPage("F04MCF - Approximate solution of real symmetric positive-definite variable-bandwidth simultaneous linear equations (coefficient matrix already factorized)",nil) - htSay '"\menuitemstyle{}\tab{2} Elements of matrix {\it AL} in row by row " - htSay '"order as returned by F01MCF: \newline " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'f04mcfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'lal,lal) - htpSetProperty(page,'ir,ir) --- htpSetProperty(page,'nrb,nrb) --- htpSetProperty(page,'nrx,nrx) - htpSetProperty(page,'iselct,iselct) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -f04mcfDefaultSolve (htPage,iselct,ifail) == - n := '6 - lal := '14 - ir := '2 - nrb := '6 - nrx := '6 - page := htInitPage("F04MCF - Approximate solution of real symmetric positive-definite variable-bandwidth simultaneous linear equations (coefficient matrix already factorized)",nil) - htMakePage '( - (domainConditions - (isDomain PI (Positive Integer)) - (isDomain F (Float))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Elements of matrix {\it AL} in row by ") - (text . "row order as returned by F01MCF: ") - (text . "\newline ") - (bcStrings (6 "1.0" x1 F)) - (bcStrings (6 "2.0" x2 F)) - (bcStrings (6 "1.0" x3 F)) - (bcStrings (6 "3.0" x4 F)) - (bcStrings (6 "1.0" x5 F)) - (bcStrings (6 "1.0" x6 F)) - (bcStrings (6 "5.0" x7 F)) - (bcStrings (6 "4.0" x8 F)) - (bcStrings (6 "1.5" x9 F)) - (bcStrings (6 "0.5" x10 F)) - (bcStrings (6 "1.0" x11 F)) - (bcStrings (6 "1.5" x12 F)) - (bcStrings (6 "5.0" x13 F)) - (bcStrings (6 "1.0" x14 F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} Diagonal elements of diagonal matrix ") - (text . "D as returned by F01MCF: ") - (text . "\newline ") - (bcStrings (6 "1.0" d1 F)) - (bcStrings (6 "1.0" d2 F)) - (bcStrings (6 "4.0" d3 F)) - (bcStrings (6 "16.0" d4 F)) - (bcStrings (6 "1.0" d5 F)) - (bcStrings (6 "16.0" d6 F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} {\it NROW(n)} the width of the ith row ") - (text . "of A: ") - (text . "\newline ") - (bcStrings (6 1 n1 PI)) - (bcStrings (6 2 n2 PI)) - (bcStrings (6 2 n3 PI)) - (bcStrings (6 1 n4 PI)) - (bcStrings (6 5 n5 PI)) - (bcStrings (6 3 n6 PI)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} The n by r right-hand side matrix B:") - (text . "\newline ") - (bcStrings (6 "6" b11 F)) - (text . "\tab{10} ") - (bcStrings (6 "-10" b12 PI)) - (text . "\newline ") - (bcStrings (6 "15" b21 F)) - (text . "\tab{10} ") - (bcStrings (6 "-21" b22 PI)) - (text . "\newline ") - (bcStrings (6 "11" b31 F)) - (text . "\tab{10} ") - (bcStrings (6 "-3" b32 PI)) - (text . "\newline ") - (bcStrings (6 "0" b41 F)) - (text . "\tab{10} ") - (bcStrings (6 "24" b42 PI)) - (text . "\newline ") - (bcStrings (6 "51" b51 F)) - (text . "\tab{10} ") - (bcStrings (6 "-39" b52 PI)) - (text . "\newline ") - (bcStrings (6 "46" b61 F)) - (text . "\tab{10} ") - (bcStrings (6 "67" b62 PI)) - (text . "\blankline ")) - htMakeDoneButton('"Continue",'f04mcfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'lal,lal) - htpSetProperty(page,'ir,ir) --- htpSetProperty(page,'nrb,nrb) --- htpSetProperty(page,'nrx,nrx) - htpSetProperty(page,'iselct,iselct) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f04mcfGen htPage == - n := htpProperty(htPage,'n) - lal := htpProperty(htPage,'lal) - ir := htpProperty(htPage,'ir) --- nrb := htpProperty(htPage,'nrb) --- nrx := htpProperty(htPage,'nrx) - nrb := n - nrx := n - iselct := htpProperty(htPage,'iselct) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - for i in 1..nrb repeat - for j in 1..ir repeat - elm := STRCONC((first y).1," ") - rowList := [elm,:rowList] - y := rest y - matform := [rowList,:matform] - rowList := [] - matfrom := REVERSE matform - matstring := bcwords2liststring [bcwords2liststring x for x in matform] - for i in 1..n repeat - right := STRCONC ((first y).1," ") - y := rest y - nrowList := [right,:nrowList] - nrowstring := bcwords2liststring nrowList - for i in 1..n repeat - right := STRCONC ((first y).1," ") - y := rest y - dList := [right,:dList] - dstring := bcwords2liststring dList - while y repeat - right := STRCONC ((first y).1," ") - y := rest y - alList := [right,:alList] - alstring := bcwords2liststring alList - prefix := STRCONC('"f04mcf(",STRINGIMAGE n,", [",alstring,"], ") - prefix := STRCONC(prefix,STRINGIMAGE lal,", [",dstring,"],[",nrowstring) - prefix := STRCONC(prefix,"]::Matrix Integer,") - prefix := STRCONC(prefix,STRINGIMAGE ir,", ",matstring,", ",STRINGIMAGE nrb) - prefix := STRCONC(prefix,", ",STRINGIMAGE iselct,", ",STRINGIMAGE nrx,", ") - bcGen STRCONC(prefix,STRINGIMAGE ifail,")") - - -f04axf() == - htInitPage('"F04AXF - Approximate solution of a a set of real sparse linear equations after factorization by F01BRF or by F01BSF",nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXf04axf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04axf| '|NagLinearEquationSolvingPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "F04AXF calculates the approximate solution of a set of real ") - (text . "sparse linear equations {\it Ax=b} or ") - (text . "\htbitmap{aTx=b}, where the {\it n} by {\it n} matrix ") - (text . "{\it A} has been factorized by F01BRF or F01BSF, {\it x} ") - (text . "is an {\it n} element vector of unknowns and {\it b} is an ") - (text . "{\it n} element right-hand side vector. ") - (text . "\blankline") - (text . "\newline ") - (text . "Read the input file to see the example program. ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "\spadcommand{)read f04axf \bound{s0}} ")) - htShowPage() - -f04maf() == - htInitPage('"F04MAF - Solution of a real sparse symmetric positive-definite system of linear equations after factorization by F01MAF",nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXf04maf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04maf| '|NagLinearEquationSolvingPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "F04MAF solves a real sparse symmetric positive-definite system ") - (text . "of linear equations {\it Ax=b} using a pre-conditioned ") - (text . "conjugate gradient method, where the {\it n} by {\it n} ") - (text . "matrix {\it A} has been factorized by F01MAF, {\it x} is an ") - (text . "{\it n} element vector of unknowns and {\it b} is an {\it n} ") - (text . "element right-hand side vector. ") - (text . "\blankline") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "\spadcommand{)read f04maf \bound{s0}} ")) - htShowPage() - -f04mbf() == - htInitPage('"F04MBF - Real sparse symmetric simultaneous linear equations",nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain PI (PositiveInteger)) - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXf04mbf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04mbf| '|NagLinearEquationSolvingPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "F04MBF solve a system of real symmetric linear equations ") - (text . "({\it A} - \lambda {\it I}){\it x} = {\it b} using a Lanczos ") - (text . "algorithm, where {\it A} is an {\it n} by {\it n} sparse ") - (text . "symmetric matrix, {\it x} is an {\it n} vector of unknowns ") - (text . "and {\it b} is an {\it n} element right-hand side vector. ") - (text . "\blankline") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Enter the order {\it n} of matrix {\it A}: ") - (text . "\newline \tab{2} ") - (bcStrings (10 10 n PI)) - (text . "\blankline") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Is preconditioning required? ") - (radioButtons precon - ("" " Yes" true) - ("" " No" false)) - (text . "\blankline") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Enter the shift in the equations \lambda, {\it shift} : ") - (text . "\newline \tab{2} ") - (bcStrings (10 "0.0" shift F)) - (text . "\blankline") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Enter the tolerance for convergence, {\it rtol}: ") - (text . "\newline \tab{2} ") - (bcStrings (10 "0.00001" rtol F)) - (text . "\blankline") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Enter an upper limit for the number of iterations, {\it itnlim}: ") - (text . "\newline \tab{2} ") - (bcStrings (10 100 itnlim PI)) - (text . "\blankline") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Enter the printing level, {\it msglvl}: ") - (text . "\newline \tab{2} ") - (bcStrings (10 1 msglvl 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", 'f04mbfSolve) - htShowPage() - -f04mbfSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - msolve := htpButtonValue(htPage,'precon) - precon := - msolve = 'true => 'true - 'false - shift := htpLabelInputString(htPage,'shift) - rtol := htpLabelInputString(htPage,'rtol) - itnlim := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'itnlim) - objValUnwrap htpLabelSpadValue(htPage, 'itnlim) - msglvl := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'msglvl) - objValUnwrap htpLabelSpadValue(htPage, 'msglvl) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - (n = '10 and precon ='true) => f04mbfDefaultSolve(htPage,shift,rtol,itnlim,msglvl,ifail) - bmatList := - "append"/[f(i) for i in 1..n] where f(i) == - bnam := INTERN STRCONC ('"b",STRINGIMAGE i) - [['bcStrings,[6, "0.0", bnam, 'F]]] - amatList := - "append"/[h(ia,n) for ia in 1..n] where h(ia,n) == - alabelList := - "append"/[k(ia,ja) for ja in 1..n] where k(ia,ja) == - anam := INTERN STRCONC ('"a",STRINGIMAGE ia,STRINGIMAGE ja) - [['bcStrings,[6, "0.0", anam, 'F]]] - prefix := ('"\newline \tab{2} ") - alabelList := [['text,:prefix],:alabelList] - start := ('"\blankline \menuitemstyle{}\tab{2} Enter the matrix {\it A}: ") - amatList := [['text,:start],:amatList] - mmatList:= - precon = 'true => - alabelList:= - "append"/[l(im,n) for im in 1..n] where l(im,n) == - mlabelList := - "append"/[o(im,jm) for jm in 1..n] where o(im,jm) == - mnam := INTERN STRCONC ('"m",STRINGIMAGE im,STRINGIMAGE jm) - [['bcStrings,[6, "0.0", mnam, 'F]]] - prefix := ('"\newline \tab{2} ") - mlabelList := [['text,:prefix],:mlabelList] - start := ('"\blankline \menuitemstyle{}\tab{2} Enter the matrix {\it m}: ") - [['text,:start],:alabelList] - [] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain F (Float))), - :bmatList,:amatList,:mmatList] - page := htInitPage('"F04MBF - Real sparse symmetric simultaneous linear equations",nil) - htSay '"\newline \menuitemstyle{}\tab{2} " - htSay '"Enter the right-hand side vector {\it b(n)}: " - htSay '"\newline \tab{2} " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'f04mbfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'precon,precon) - htpSetProperty(page,'shift,shift) - htpSetProperty(page,'rtol,rtol) - htpSetProperty(page,'itnlim,itnlim) - htpSetProperty(page,'msglvl,msglvl) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f04mbfDefaultSolve (htPage,shift,rtol,itnlim,msglvl,ifail) == - n := '10 - precon := 'true - page := htInitPage('"F04MBF - Real sparse symmetric simultaneous linear equations",nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Enter the right-hand side vector {\it b(n)}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 "6.0" b1 F)) - (bcStrings (6 "4.0" b2 F)) - (bcStrings (6 "4.0" b3 F)) - (bcStrings (6 "4.0" b4 F)) - (bcStrings (6 "4.0" b5 F)) - (bcStrings (6 "4.0" b6 F)) - (bcStrings (6 "4.0" b7 F)) - (bcStrings (6 "4.0" b8 F)) - (bcStrings (6 "4.0" b9 F)) - (bcStrings (6 "6.0" b10 F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Enter the matrix {\it A}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 "2.0" a11 F)) - (bcStrings (6 "1.0" a12 F)) - (bcStrings (6 "0.0" a13 F)) - (bcStrings (6 "0.0" a14 F)) - (bcStrings (6 "0.0" a15 F)) - (bcStrings (6 "0.0" a16 F)) - (bcStrings (6 "0.0" a17 F)) - (bcStrings (6 "0.0" a18 F)) - (bcStrings (6 "0.0" a19 F)) - (bcStrings (6 "3.0" a110 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "1.0" a21 F)) - (bcStrings (6 "2.0" a22 F)) - (bcStrings (6 "1.0" a23 F)) - (bcStrings (6 "0.0" a24 F)) - (bcStrings (6 "0.0" a25 F)) - (bcStrings (6 "0.0" a26 F)) - (bcStrings (6 "0.0" a27 F)) - (bcStrings (6 "0.0" a28 F)) - (bcStrings (6 "0.0" a29 F)) - (bcStrings (6 "0.0" a210 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" a31 F)) - (bcStrings (6 "1.0" a32 F)) - (bcStrings (6 "2.0" a33 F)) - (bcStrings (6 "1.0" a34 F)) - (bcStrings (6 "0.0" a35 F)) - (bcStrings (6 "0.0" a36 F)) - (bcStrings (6 "0.0" a37 F)) - (bcStrings (6 "0.0" a38 F)) - (bcStrings (6 "0.0" a39 F)) - (bcStrings (6 "0.0" a310 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" a41 F)) - (bcStrings (6 "0.0" a42 F)) - (bcStrings (6 "1.0" a43 F)) - (bcStrings (6 "2.0" a44 F)) - (bcStrings (6 "1.0" a45 F)) - (bcStrings (6 "0.0" a46 F)) - (bcStrings (6 "0.0" a47 F)) - (bcStrings (6 "0.0" a48 F)) - (bcStrings (6 "0.0" a49 F)) - (bcStrings (6 "0.0" a410 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" a51 F)) - (bcStrings (6 "0.0" a52 F)) - (bcStrings (6 "0.0" a53 F)) - (bcStrings (6 "1.0" a54 F)) - (bcStrings (6 "2.0" a55 F)) - (bcStrings (6 "1.0" a56 F)) - (bcStrings (6 "0.0" a57 F)) - (bcStrings (6 "0.0" a58 F)) - (bcStrings (6 "0.0" a59 F)) - (bcStrings (6 "0.0" a510 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" a61 F)) - (bcStrings (6 "0.0" a62 F)) - (bcStrings (6 "0.0" a63 F)) - (bcStrings (6 "0.0" a64 F)) - (bcStrings (6 "1.0" a65 F)) - (bcStrings (6 "2.0" a66 F)) - (bcStrings (6 "1.0" a67 F)) - (bcStrings (6 "0.0" a68 F)) - (bcStrings (6 "0.0" a69 F)) - (bcStrings (6 "0.0" a610 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" a71 F)) - (bcStrings (6 "0.0" a72 F)) - (bcStrings (6 "0.0" a73 F)) - (bcStrings (6 "0.0" a74 F)) - (bcStrings (6 "0.0" a75 F)) - (bcStrings (6 "1.0" a76 F)) - (bcStrings (6 "2.0" a77 F)) - (bcStrings (6 "1.0" a78 F)) - (bcStrings (6 "0.0" a79 F)) - (bcStrings (6 "0.0" a710 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" a81 F)) - (bcStrings (6 "0.0" a82 F)) - (bcStrings (6 "0.0" a83 F)) - (bcStrings (6 "0.0" a84 F)) - (bcStrings (6 "0.0" a85 F)) - (bcStrings (6 "0.0" a86 F)) - (bcStrings (6 "1.0" a87 F)) - (bcStrings (6 "2.0" a88 F)) - (bcStrings (6 "1.0" a89 F)) - (bcStrings (6 "0.0" a810 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" a91 F)) - (bcStrings (6 "0.0" a92 F)) - (bcStrings (6 "0.0" a93 F)) - (bcStrings (6 "0.0" a94 F)) - (bcStrings (6 "0.0" a95 F)) - (bcStrings (6 "0.0" a96 F)) - (bcStrings (6 "0.0" a97 F)) - (bcStrings (6 "1.0" a98 F)) - (bcStrings (6 "2.0" a99 F)) - (bcStrings (6 "1.0" a910 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "3.0" a101 F)) - (bcStrings (6 "0.0" a102 F)) - (bcStrings (6 "0.0" a103 F)) - (bcStrings (6 "0.0" a104 F)) - (bcStrings (6 "0.0" a105 F)) - (bcStrings (6 "0.0" a106 F)) - (bcStrings (6 "0.0" a107 F)) - (bcStrings (6 "0.0" a108 F)) - (bcStrings (6 "1.0" a109 F)) - (bcStrings (6 "2.0" a1010 F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Enter the matrix {\it m}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 "2.0" m11 F)) - (bcStrings (6 "1.0" m12 F)) - (bcStrings (6 "0.0" m13 F)) - (bcStrings (6 "0.0" m14 F)) - (bcStrings (6 "0.0" m15 F)) - (bcStrings (6 "0.0" m16 F)) - (bcStrings (6 "0.0" m17 F)) - (bcStrings (6 "0.0" m18 F)) - (bcStrings (6 "0.0" m19 F)) - (bcStrings (6 "0.0" m110 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "1.0" m21 F)) - (bcStrings (6 "2.0" m22 F)) - (bcStrings (6 "1.0" m23 F)) - (bcStrings (6 "0.0" m24 F)) - (bcStrings (6 "0.0" m25 F)) - (bcStrings (6 "0.0" m26 F)) - (bcStrings (6 "0.0" m27 F)) - (bcStrings (6 "0.0" m28 F)) - (bcStrings (6 "0.0" m29 F)) - (bcStrings (6 "0.0" m210 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" m31 F)) - (bcStrings (6 "1.0" m32 F)) - (bcStrings (6 "2.0" m33 F)) - (bcStrings (6 "1.0" m34 F)) - (bcStrings (6 "0.0" m35 F)) - (bcStrings (6 "0.0" m36 F)) - (bcStrings (6 "0.0" m37 F)) - (bcStrings (6 "0.0" m38 F)) - (bcStrings (6 "0.0" m39 F)) - (bcStrings (6 "0.0" m310 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" m41 F)) - (bcStrings (6 "0.0" m42 F)) - (bcStrings (6 "1.0" m43 F)) - (bcStrings (6 "2.0" m44 F)) - (bcStrings (6 "1.0" m45 F)) - (bcStrings (6 "0.0" m46 F)) - (bcStrings (6 "0.0" m47 F)) - (bcStrings (6 "0.0" m48 F)) - (bcStrings (6 "0.0" m49 F)) - (bcStrings (6 "0.0" m410 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" m51 F)) - (bcStrings (6 "0.0" m52 F)) - (bcStrings (6 "0.0" m53 F)) - (bcStrings (6 "1.0" m54 F)) - (bcStrings (6 "2.0" m55 F)) - (bcStrings (6 "1.0" m56 F)) - (bcStrings (6 "0.0" m57 F)) - (bcStrings (6 "0.0" m58 F)) - (bcStrings (6 "0.0" m59 F)) - (bcStrings (6 "0.0" m510 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" m61 F)) - (bcStrings (6 "0.0" m62 F)) - (bcStrings (6 "0.0" m63 F)) - (bcStrings (6 "0.0" m64 F)) - (bcStrings (6 "1.0" m65 F)) - (bcStrings (6 "2.0" m66 F)) - (bcStrings (6 "1.0" m67 F)) - (bcStrings (6 "0.0" m68 F)) - (bcStrings (6 "0.0" m69 F)) - (bcStrings (6 "0.0" m610 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" m71 F)) - (bcStrings (6 "0.0" m72 F)) - (bcStrings (6 "0.0" m73 F)) - (bcStrings (6 "0.0" m74 F)) - (bcStrings (6 "0.0" m75 F)) - (bcStrings (6 "1.0" m76 F)) - (bcStrings (6 "2.0" m77 F)) - (bcStrings (6 "1.0" m78 F)) - (bcStrings (6 "0.0" m79 F)) - (bcStrings (6 "0.0" m710 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" m81 F)) - (bcStrings (6 "0.0" m82 F)) - (bcStrings (6 "0.0" m83 F)) - (bcStrings (6 "0.0" m84 F)) - (bcStrings (6 "0.0" m85 F)) - (bcStrings (6 "0.0" m86 F)) - (bcStrings (6 "1.0" m87 F)) - (bcStrings (6 "2.0" m88 F)) - (bcStrings (6 "1.0" m89 F)) - (bcStrings (6 "0.0" m810 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" m91 F)) - (bcStrings (6 "0.0" m92 F)) - (bcStrings (6 "0.0" m93 F)) - (bcStrings (6 "0.0" m94 F)) - (bcStrings (6 "0.0" m95 F)) - (bcStrings (6 "0.0" m96 F)) - (bcStrings (6 "0.0" m97 F)) - (bcStrings (6 "1.0" m98 F)) - (bcStrings (6 "2.0" m99 F)) - (bcStrings (6 "1.0" m910 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" m101 F)) - (bcStrings (6 "0.0" m102 F)) - (bcStrings (6 "0.0" m103 F)) - (bcStrings (6 "0.0" m104 F)) - (bcStrings (6 "0.0" m105 F)) - (bcStrings (6 "0.0" m106 F)) - (bcStrings (6 "0.0" m107 F)) - (bcStrings (6 "0.0" m108 F)) - (bcStrings (6 "1.0" m109 F)) - (bcStrings (6 "2.0" m1010 F)) - (text . "\blankline ")) - htMakeDoneButton('"Continue",'f04mbfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'precon,precon) - htpSetProperty(page,'shift,shift) - htpSetProperty(page,'rtol,rtol) - htpSetProperty(page,'itnlim,itnlim) - htpSetProperty(page,'msglvl,msglvl) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f04mbfGen htPage == - n := htpProperty(htPage,'n) - precon := htpProperty(htPage,'precon) - shift := htpProperty(htPage,'shift) - rtol := htpProperty(htPage,'rtol) - itnlim := htpProperty(htPage,'itnlim) - msglvl := htpProperty(htPage,'msglvl) - ifail := htpProperty(htPage,'ifail) - lrwork := '1 - liwork := '1 - alist := htpInputAreaAlist htPage - y := alist - if (precon = 'true) then - for i in 1..n repeat - for j in 1..n repeat - melm := STRCONC((first y).1," ") - mrowlist := [melm,:mrowlist] - y := rest y - matm := [mrowlist,:matm] - mrowlist := [] - mstring := bcwords2liststring [bcwords2liststring x for x in matm] - for k in 1..n repeat - for l in 1..n repeat - aelm := STRCONC((first y).1," ") - arowlist := [aelm,:arowlist] - y := rest y - mata := [arowlist,:mata] - arowlist := [] - astring := bcwords2liststring [bcwords2liststring y for y in mata] - for z in 1..n repeat - belm := STRCONC((first y).1," ") - blist := [belm,:blist] - y := rest y - bstring := bcwords2liststring blist - if (precon = 'false) then - mstring := astring - prefix := STRCONC('"f04mbf(",STRINGIMAGE n,",[",bstring,"]::Matrix DoubleFloat,",precon,",") - prefix := STRCONC(prefix,STRINGIMAGE shift,",",STRINGIMAGE itnlim,",",STRINGIMAGE msglvl,",") - prefix := STRCONC(prefix,STRINGIMAGE lrwork,",",STRINGIMAGE liwork,",") - prefix := STRCONC(prefix,STRINGIMAGE rtol,",",STRINGIMAGE ifail,",((") - prefix := STRCONC(prefix,astring,"::Matrix MachineFloat)::ASP28(APROD)),((") - prefix := STRCONC(prefix,mstring,"::Matrix MachineFloat)::ASP34(MSOLVE)))") - linkGen prefix - - --- f04qaf() == --- htInitPage('"F04QAF - Solution of sparse unsymmetric equations, linear and damped least-squares problems using a Lanczos algorithm",nil) --- htMakePage '( --- (domainConditions --- (isDomain EM $EmptyMode) --- (isDomain F (Float))) --- (text . "\windowlink{Manual Page}{manpageXXf04qaf} for this routine ") --- (text . "\newline ") --- (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04qaf| '|NagLinearEquationSolvingPackage|)} for this routine") --- (text . "\newline \horizontalline ") --- (text . "\newline ") --- (text . "F04QAF solves sparse unsymmetric equations, sparse linear ") --- (text . "least-squares problems and sparse damped least-squares ") --- (text . "problems, using a Lanczos algorithm. Specifically, the ") --- (text . "routine can be used to solve a system of linear equations ") --- (text . "{\it Ax=b}, where {\it A} is an {\it n} by {\it n} real ") --- (text . "sparse unsymmetric matrix, or can be used to solve linear ") --- (text . "least-squares problems, so that it minimizes the the value ") --- (text . "{\htbitmap{newrho}} given by {\htbitmap{rho=r}}, ") --- (text . "{\it r=b-AX} where {\it A} is an {\it m} by {\it n} real ") --- (text . "sparse matrix. A damping parameter \lambda may ") --- (text . "be included in the least squares problem in which case the ") --- (text . "routine minimizes the value {\htbitmap{newrho}} given by ") --- (text . "{\htbitmap{rhosq=}}. \newline ") --- (text . "\blankline ") --- (text . "\menuitemstyle{}\tab{2}") --- (text . "\spadcommand{)read f04qaf \bound{s0}} ")) --- htShowPage() - --- f04mbf() == --- htInitPage('"F04MBF - Real sparse symmetric simultaneous linear equations",nil) --- htMakePage '( --- (domainConditions --- (isDomain EM $EmptyMode) --- (isDomain F (Float))) --- (text . "\windowlink{Manual Page}{manpageXXf04mbf} for this routine ") --- (text . "\newline ") --- (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04mbf| '|NagLinearEquationSolvingPackage|)} for this routine") --- (text . "\newline \horizontalline ") --- (text . "\newline ") --- (text . "\newline ") --- (text . "F04MBF solve a system of real symmetric linear equations ") --- (text . "({\it A} - \lambda {\it I}){\it x} = {\it b} using a Lanczos ") --- (text . "algorithm, where {\it A} is an {\it n} by {\it n} sparse ") --- (text . "symmetric matrix, {\it x} is an {\it n} vector of unknowns ") --- (text . "and {\it b} is an {\it n} element right-hand side vector. ") --- (text . "\blankline") --- (text . "\newline ") --- (text . "\menuitemstyle{}\tab{2} ") --- (text . "\spadcommand{)read f04mbf \bound{s0}} ")) --- htShowPage() - -f04qaf() == - htInitPage('"F04QAF - Solution of sparse unsymmetric equations, linear and damped least-squares problems using a Lanczos algorithm",nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain PI (PositiveInteger)) - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXf04qaf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04qaf| '|NagLinearEquationSolvingPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "F04QAF solves sparse unsymmetric equations, sparse linear ") - (text . "least-squares problems and sparse damped least-squares ") - (text . "problems, using a Lanczos algorithm. Specifically, the ") - (text . "routine can be used to solve a system of linear equations ") - (text . "{\it Ax=b}, where {\it A} is an {\it n} by {\it n} real ") - (text . "sparse unsymmetric matrix, or can be used to solve linear ") - (text . "least-squares problems, so that it minimizes the the value ") - (text . "{\htbitmap{newrho}} given by {\htbitmap{rho=r}}, ") - (text . "{\it r=b-AX} where {\it A} is an {\it m} by {\it n} real ") - (text . "sparse matrix. A damping parameter \lambda may ") - (text . "be included in the least squares problem in which case the ") - (text . "routine minimizes the value {\htbitmap{newrho}} given by ") - (text . "{\htbitmap{rhosq=}}. \newline ") - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the number of rows of the matrix {\it A}, {\it m}:") - (text . "\newline \tab{2}") - (bcStrings (10 13 m PI)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the number of columns of the matrix {\it A}, {\it n}:") - (text . "\newline \tab{2}") - (bcStrings (10 12 n PI)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the damping parameter \lambda, {\it damp}:") - (text . "\newline \tab{2}") - (bcStrings (10 "0.0" damp F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the tolerance for elements of {\it A}, {\it atol}:") - (text . "\newline \tab{2}") - (bcStrings (10 "0.00001" atol F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the tolerance for elements of {\it b}, {\it btol}:") - (text . "\newline \tab{2}") - (bcStrings (10 "0.0001" btol F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the maximum number of iterations {\it itnlim}:") - (text . "\newline \tab{2}") - (bcStrings (10 100 itnlim PI)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the printing level {\it msglvl}:") - (text . "\newline \tab{2}") - (bcStrings (10 1 msglvl PI)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'f04qafSolve) - htShowPage() - -f04qafSolve htPage == - m := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) - objValUnwrap htpLabelSpadValue(htPage, 'm) - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - damp := htpLabelInputString(htPage,'damp) - atol := htpLabelInputString(htPage,'atol) - btol := htpLabelInputString(htPage,'btol) - itnlim := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'itnlim) - objValUnwrap htpLabelSpadValue(htPage, 'itnlim) - msglvl := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'msglvl) - objValUnwrap htpLabelSpadValue(htPage, 'msglvl) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - (m = '13 and n = '12) => f04qafDefaultSolve(htPage,damp,atol,btol,itnlim,msglvl,ifail) - bmatList := - "append"/[f(i) for i in 1..m] where f(i) == - bnam := INTERN STRCONC ('"b",STRINGIMAGE i) - [['bcStrings,[6, "0.0", bnam, 'F]]] - amatList := - "append"/[h(ia,n) for ia in 1..m] where h(ia,n) == - alabelList := - "append"/[k(ia,ja) for ja in 1..n] where k(ia,ja) == - anam := INTERN STRCONC ('"a",STRINGIMAGE ia,STRINGIMAGE ja) - [['bcStrings,[6, "0.0", anam, 'F]]] - prefix := ('"\newline \tab{2} ") - alabelList := [['text,:prefix],:alabelList] - start := ('"\blankline \menuitemstyle{}\tab{2} Enter the matrix {\it A}: ") - amatList := [['text,:start],:amatList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain F (Float))), - :bmatList,:amatList] - page := htInitPage('"F04QAF - Solution of sparse unsymmetric equations, linear and damped least-squares problems using a Lanczos algorithm",nil) - htSay '"\newline \menuitemstyle{}\tab{2} " - htSay '"Enter the right-hand side vector {\it b(m)}: " - htSay '"\newline \tab{2} " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'f04qafGen) - htpSetProperty(page,'m,m) - htpSetProperty(page,'n,n) - htpSetProperty(page,'damp,damp) - htpSetProperty(page,'atol,atol) - htpSetProperty(page,'btol,btol) - htpSetProperty(page,'itnlim,itnlim) - htpSetProperty(page,'msglvl,msglvl) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - - -f04qafDefaultSolve (htPage,damp,atol,btol,itnlim,msglvl,ifail) == - m := '13 - n := '12 - page := htInitPage('"F04QAF - Solution of sparse unsymmetric equations, linear and damped least-squares problems using a Lanczos algorithm",nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Enter the right-hand side vector {\it b(n)}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" b1 F)) - (bcStrings (6 "0.0" b2 F)) - (bcStrings (6 "0.0" b3 F)) - (bcStrings (6 "-0.01" b4 F)) - (bcStrings (6 "-0.01" b5 F)) - (bcStrings (6 "0.0" b6 F)) - (bcStrings (6 "0.0" b7 F)) - (bcStrings (6 "-0.01" b8 F)) - (bcStrings (6 "-0.01" b9 F)) - (bcStrings (6 "0.0" b10 F)) - (bcStrings (6 "0.0" b11 F)) - (bcStrings (6 "0.0" b12 F)) - (bcStrings (6 "10.0" b13 F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Enter the matrix {\it A}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 "1.0" a0101 F)) - (bcStrings (6 "0.0" a0102 F)) - (bcStrings (6 "0.0" a0103 F)) - (bcStrings (6 "-1.0" a0104 F)) - (bcStrings (6 "0.0" a0105 F)) - (bcStrings (6 "0.0" a0106 F)) - (bcStrings (6 "0.0" a0107 F)) - (bcStrings (6 "0.0" a0108 F)) - (bcStrings (6 "0.0" a0109 F)) - (bcStrings (6 "0.0" a0110 F)) - (bcStrings (6 "0.0" a0111 F)) - (bcStrings (6 "0.0" a0112 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" a0201 F)) - (bcStrings (6 "1.0" a0202 F)) - (bcStrings (6 "0.0" a0203 F)) - (bcStrings (6 "0.0" a0204 F)) - (bcStrings (6 "-1.0" a0205 F)) - (bcStrings (6 "0.0" a0206 F)) - (bcStrings (6 "0.0" a0207 F)) - (bcStrings (6 "0.0" a0208 F)) - (bcStrings (6 "0.0" a0209 F)) - (bcStrings (6 "0.0" a0210 F)) - (bcStrings (6 "0.0" a0211 F)) - (bcStrings (6 "0.0" a0212 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" a0301 F)) - (bcStrings (6 "0.0" a0302 F)) - (bcStrings (6 "1.0" a0303 F)) - (bcStrings (6 "-1.0" a0304 F)) - (bcStrings (6 "0.0" a0305 F)) - (bcStrings (6 "0.0" a0306 F)) - (bcStrings (6 "0.0" a0307 F)) - (bcStrings (6 "0.0" a0308 F)) - (bcStrings (6 "0.0" a0309 F)) - (bcStrings (6 "0.0" a0310 F)) - (bcStrings (6 "0.0" a0311 F)) - (bcStrings (6 "0.0" a0312 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "-1.0" a0401 F)) - (bcStrings (6 "0.0" a0402 F)) - (bcStrings (6 "-1.0" a0403 F)) - (bcStrings (6 "4.0" a0404 F)) - (bcStrings (6 "-1.0" a0405 F)) - (bcStrings (6 "0.0" a0406 F)) - (bcStrings (6 "0.0" a0407 F)) - (bcStrings (6 "-1.0" a0408 F)) - (bcStrings (6 "0.0" a0409 F)) - (bcStrings (6 "0.0" a0410 F)) - (bcStrings (6 "0.0" a0411 F)) - (bcStrings (6 "0.0" a0412 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" a0501 F)) - (bcStrings (6 "-1.0" a0502 F)) - (bcStrings (6 "0.0" a0503 F)) - (bcStrings (6 "-1.0" a0504 F)) - (bcStrings (6 "4.0" a0505 F)) - (bcStrings (6 "-1.0" a0506 F)) - (bcStrings (6 "0.0" a0507 F)) - (bcStrings (6 "0.0" a0508 F)) - (bcStrings (6 "-1.0" a0509 F)) - (bcStrings (6 "0.0" a0510 F)) - (bcStrings (6 "0.0" a0511 F)) - (bcStrings (6 "0.0" a0512 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" a0601 F)) - (bcStrings (6 "0.0" a0602 F)) - (bcStrings (6 "0.0" a0603 F)) - (bcStrings (6 "0.0" a0604 F)) - (bcStrings (6 "-1.0" a0605 F)) - (bcStrings (6 "1.0" a0606 F)) - (bcStrings (6 "0.0" a0607 F)) - (bcStrings (6 "0.0" a0608 F)) - (bcStrings (6 "0.0" a0609 F)) - (bcStrings (6 "0.0" a0610 F)) - (bcStrings (6 "0.0" a0611 F)) - (bcStrings (6 "0.0" a0612 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" a0701 F)) - (bcStrings (6 "0.0" a0702 F)) - (bcStrings (6 "0.0" a0703 F)) - (bcStrings (6 "0.0" a0704 F)) - (bcStrings (6 "0.0" a0705 F)) - (bcStrings (6 "0.0" a0706 F)) - (bcStrings (6 "1.0" a0707 F)) - (bcStrings (6 "-1.0" a0708 F)) - (bcStrings (6 "0.0" a0709 F)) - (bcStrings (6 "0.0" a0710 F)) - (bcStrings (6 "0.0" a0711 F)) - (bcStrings (6 "0.0" a0712 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" a0801 F)) - (bcStrings (6 "0.0" a0802 F)) - (bcStrings (6 "0.0" a0803 F)) - (bcStrings (6 "-1.0" a0804 F)) - (bcStrings (6 "0.0" a0805 F)) - (bcStrings (6 "0.0" a0806 F)) - (bcStrings (6 "-1.0" a0807 F)) - (bcStrings (6 "4.0" a0808 F)) - (bcStrings (6 "-1.0" a0809 F)) - (bcStrings (6 "0.0" a0810 F)) - (bcStrings (6 "-1.0" a0811 F)) - (bcStrings (6 "0.0" a0812 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" a0901 F)) - (bcStrings (6 "0.0" a0902 F)) - (bcStrings (6 "0.0" a0903 F)) - (bcStrings (6 "0.0" a0904 F)) - (bcStrings (6 "-1.0" a0905 F)) - (bcStrings (6 "0.0" a0906 F)) - (bcStrings (6 "0.0" a0907 F)) - (bcStrings (6 "-1.0" a0908 F)) - (bcStrings (6 "4.0" a0909 F)) - (bcStrings (6 "-1.0" a0910 F)) - (bcStrings (6 "0.0" a0911 F)) - (bcStrings (6 "-1.0" a0912 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" a1001 F)) - (bcStrings (6 "0.0" a1002 F)) - (bcStrings (6 "0.0" a1003 F)) - (bcStrings (6 "0.0" a1004 F)) - (bcStrings (6 "0.0" a1005 F)) - (bcStrings (6 "0.0" a1006 F)) - (bcStrings (6 "0.0" a1007 F)) - (bcStrings (6 "0.0" a1008 F)) - (bcStrings (6 "-1.0" a1009 F)) - (bcStrings (6 "1.0" a1010 F)) - (bcStrings (6 "0.0" a1011 F)) - (bcStrings (6 "0.0" a1012 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" a1101 F)) - (bcStrings (6 "0.0" a1102 F)) - (bcStrings (6 "0.0" a1103 F)) - (bcStrings (6 "0.0" a1104 F)) - (bcStrings (6 "0.0" a1105 F)) - (bcStrings (6 "0.0" a1106 F)) - (bcStrings (6 "0.0" a1107 F)) - (bcStrings (6 "-1.0" a1108 F)) - (bcStrings (6 "0.0" a1109 F)) - (bcStrings (6 "0.0" a1110 F)) - (bcStrings (6 "1.0" a1111 F)) - (bcStrings (6 "0.0" a1112 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" a1201 F)) - (bcStrings (6 "0.0" a1202 F)) - (bcStrings (6 "0.0" a1203 F)) - (bcStrings (6 "0.0" a1204 F)) - (bcStrings (6 "0.0" a1205 F)) - (bcStrings (6 "0.0" a1206 F)) - (bcStrings (6 "0.0" a1207 F)) - (bcStrings (6 "0.0" a1208 F)) - (bcStrings (6 "-1.0" a1209 F)) - (bcStrings (6 "0.0" a1210 F)) - (bcStrings (6 "0.0" a1211 F)) - (bcStrings (6 "1.0" a1212 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "1.0" a1301 F)) - (bcStrings (6 "1.0" a1302 F)) - (bcStrings (6 "1.0" a1303 F)) - (bcStrings (6 "0.0" a1304 F)) - (bcStrings (6 "0.0" a1305 F)) - (bcStrings (6 "1.0" a1306 F)) - (bcStrings (6 "1.0" a1307 F)) - (bcStrings (6 "0.0" a1308 F)) - (bcStrings (6 "0.0" a1309 F)) - (bcStrings (6 "1.0" a1310 F)) - (bcStrings (6 "1.0" a1311 F)) - (bcStrings (6 "1.0" a1312 F)) - (text . "\blankline ")) - htMakeDoneButton('"Continue",'f04qafGen) - htpSetProperty(page,'m,m) - htpSetProperty(page,'n,n) - htpSetProperty(page,'damp,damp) - htpSetProperty(page,'atol,atol) - htpSetProperty(page,'btol,btol) - htpSetProperty(page,'itnlim,itnlim) - htpSetProperty(page,'msglvl,msglvl) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f04qafGen htPage == - m := htpProperty(htPage,'m) - n := htpProperty(htPage,'n) - damp := htpProperty(htPage,'damp) - atol := htpProperty(htPage,'atol) - btol := htpProperty(htPage,'btol) - divisor := READ_-FROM_-STRING(atol) - if (divisor < 1.0e-7) then divisor:=1.0e-7 - conlim := 1.0/divisor - itnlim := htpProperty(htPage,'itnlim) - msglvl := htpProperty(htPage,'msglvl) - ifail := htpProperty(htPage,'ifail) - lrwork := 1 - liwork := 1 - alist := htpInputAreaAlist htPage - y := alist - for k in 1..m repeat - for l in 1..n repeat - aelm := STRCONC((first y).1," ") - arowlist := [aelm,:arowlist] - y := rest y - mata := [arowlist,:mata] - arowlist := [] - astring := bcwords2liststring [bcwords2liststring y for y in mata] - for z in 1..m repeat - belm := STRCONC((first y).1," ") - blist := [belm,:blist] - y := rest y - bstring := bcwords2liststring blist - prefix := STRCONC('"f04qaf(",STRINGIMAGE m,",",STRINGIMAGE n,",") - prefix := STRCONC(prefix,STRINGIMAGE damp,",") - prefix := STRCONC(prefix,STRINGIMAGE atol,",",STRINGIMAGE btol,",") - prefix := STRCONC(prefix,STRINGIMAGE conlim,",",STRINGIMAGE itnlim,",",STRINGIMAGE msglvl,",") - prefix := STRCONC(prefix,STRINGIMAGE lrwork,",",STRINGIMAGE liwork,",") - prefix := STRCONC(prefix,"[",bstring,"]::Matrix DoubleFloat,") - prefix := STRCONC(prefix,STRINGIMAGE ifail,",((",astring,"::Matrix MachineFloat)::ASP30(APROD)))") - linkGen prefix - - - - - -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/nag-f07.boot b/src/interp/nag-f07.boot new file mode 100644 index 00000000..1784e006 --- /dev/null +++ b/src/interp/nag-f07.boot @@ -0,0 +1,706 @@ +-- 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. + + +)package "BOOT" + +f07adf() == + htInitPage('"F07ADF - {\it LU} factorization of real {\it m} by {\it n} matrix",nil) + htMakePage '( + (domainConditions + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXf07adf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f07adf| '|NagLapack|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\newline ") + (text . "F07ADF computes the {\it LU} factorization of a real {\it m}") + (text . " by {\it n} matrix ") + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Number of rows {\it m}:") + (text . "\newline\tab{2} ") + (bcStrings (5 4 m PI)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Number of columns {\it n}:") + (text . "\newline\tab{2} ") + (bcStrings (5 4 n PI)) + ) +-- (text . "\blankline ") +-- (text . "\menuitemstyle{}\tab{2}") +-- (text . "First dimension of array A, {\it lda}:") +-- (text . "\newline\tab{2} ") +-- (bcStrings (5 4 lda PI)) + htMakeDoneButton('"Continue", 'f07adfSolve) + htShowPage() + +f07adfSolve htPage == + m := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) + objValUnwrap htpLabelSpadValue(htPage, 'm) + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + lda := m + (n = '4 and m = '4) => f07adfDefaultSolve(htPage,lda) + aList := + "append"/[fa(i,n) for i in 1..m] 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,[6, 0, anam, 'F]]] + prefix := ('"\newline ") + labelList := [['text,:prefix],:labelList] + equationPart := [ + '(domainConditions + (isDomain EM $EmptyMode) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain I (Integer))), + :aList] + page := htInitPage('"F07ADF - {\it LU} factorization of real {\it m} by {\it n} matrix",nil) + htSay '"\menuitemstyle{}\tab{2} " + htSay '"Enter the array {\it A}:" + htSay '"\newline " + htMakePage equationPart + htMakeDoneButton('"Continue",'f07adfGen) + htpSetProperty(page,'n,n) + htpSetProperty(page,'m,m) +-- htpSetProperty(page,'lda,lda) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +f07adfDefaultSolve (htPage,lda) == + n := '4 + m := '4 + page := htInitPage('"F07ADF - {\it LU} factorization of real {\it m} by {\it n} matrix",nil) + htMakePage '( + (domainConditions + (isDomain EM $EmptyMode) + (isDomain F (Float)) + (isDomain I (Integer))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the array {\it A}:") + (text . "\newline ") + (bcStrings (5 "1.8" a11 F)) + (bcStrings (5 "2.88" a12 F)) + (bcStrings (5 "2.05" a13 F)) + (bcStrings (5 "-0.89" a14 F)) + (text . "\newline ") + (bcStrings (5 "5.25" a21 F)) + (bcStrings (5 "-2.95" a22 F)) + (bcStrings (5 "-0.95" a23 F)) + (bcStrings (5 "-3.8" a24 F)) + (text . "\newline ") + (bcStrings (5 "1.58" a31 F)) + (bcStrings (5 "-2.69" a32 F)) + (bcStrings (5 "-2.9" a33 F)) + (bcStrings (5 "-1.04" a34 F)) + (text . "\newline ") + (bcStrings (5 "-1.11" a41 F)) + (bcStrings (5 "-0.66" a42 F)) + (bcStrings (5 "-0.59" a43 F)) + (bcStrings (5 "0.8" a44 F))) + htpSetProperty(page,'n,n) + htpSetProperty(page,'m,m) +-- htpSetProperty(page,'lda,lda) + htMakeDoneButton('"Continue",'f07adfGen) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +f07adfGen htPage == + n := htpProperty(htPage, 'n) + m := htpProperty(htPage, 'm) + lda := m + alist := htpInputAreaAlist htPage + y := alist + for i in 1..n repeat + for j in 1..m repeat + a := STRCONC((first y).1," ") + rowList := [a,:rowList] + y := rest y + aList := [rowList,:aList] + rowList := [] + astring := bcwords2liststring [bcwords2liststring x for x in aList] + prefix := STRCONC("f07adf(",STRINGIMAGE m,", ",STRINGIMAGE n,", ") + prefix := STRCONC(prefix,STRINGIMAGE lda,", ",astring,")") + linkGen prefix + + +f07aef() == + htInitPage('"F07AEF - Solution of a real system of linear equations with multiple right-hand sides after factorization by F07ADF",nil) + htMakePage '( + (domainConditions + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXf07aef} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f07aef| '|NagLapack|)} for this routine") + (text . "\newline \horizontalline ") + (text . "F07AEF solves a real system of linear equations with multiple right-hand sides, {\it AX=B} or ") + (text . "\htbitmap{aTx=b} , where {\it a} has been factorized by F07ADF ") + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Form of the equations:") + (text . "\blankline ") + (radioButtons trans + ("" " N, the equations are {\it AX=B}" norm) + ("" " T, the equations are \htbitmap{aTx=b}" transp)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "The order {\it n} of {\it A}: ") + (text . "\newline ") + (bcStrings (5 4 n PI)) +-- (text . "\blankline ") +-- (text . "\menuitemstyle{}\tab{2}") +-- (text . "The order {\it m} of {\it A} used by F07AEF: ") +-- (text . "\newline ") +-- (bcStrings (5 4 m PI)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "The number of right-hand sides, {\it nrhs}: ") + (text . "\newline ") + (bcStrings (5 2 nrhs PI)) +-- (text . "\blankline ") +-- (text . "\menuitemstyle{}\tab{2}") +-- (text . "First dimension of {\it A}, {\it lda}: ") +-- (text . "\newline ") +-- (bcStrings (5 4 lda PI)) +-- (text . "\blankline ") +-- (text . "\menuitemstyle{}\tab{2}") +-- (text . "First dimension of {\it B}, {\it ldb}: ") +-- (text . "\newline ") +-- (bcStrings (5 4 ldb PI)) + ) + htMakeDoneButton('"Continue", 'f07aefSolve) + htShowPage() + +f07aefSolve htPage == + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) +-- m := +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) +-- objValUnwrap htpLabelSpadValue(htPage, 'm) + nrhs := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nrhs) + objValUnwrap htpLabelSpadValue(htPage, 'nrhs) + lda := n +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lda) +-- objValUnwrap htpLabelSpadValue(htPage, 'lda) + ldb := n +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ldb) +-- objValUnwrap htpLabelSpadValue(htPage, 'ldb) + equa := htpButtonValue(htPage, 'trans) + trans := + equa = 'norm => '"N" + '"T" + (n = '4 and nrhs = '2 ) => f07aefDefaultSolve (htPage,trans) + aList := + "append"/[fa(i,n) for i in 1..lda] where fa(i,n) == + labelList := + "append"/[faa(i,j) for j in 1..n] where faa(i,j) == + anam := INTERN STRCONC ('"a",STRINGIMAGE i,STRINGIMAGE j) + [['bcStrings, [6, 0, anam, 'F]]] + prefix := ('"\newline ") + labelList := [['text,:prefix],:labelList] + ipList := + [fp(i) for i in 1..n] where fp(i) == + ipnam := INTERN STRCONC ('"ip",STRINGIMAGE i) + ['bcStrings,[5, 0, ipnam, 'I]] + middle := ('"\blankline \menuitemstyle{}\tab{2} Enter the pivot ") + middle := STRCONC(middle,'"indices {\it IPIV} from F07ADF: ") + middle := STRCONC(middle,'"\newline ") + ipList := [['text,:middle],:ipList] + bList := + "append"/[fb(i,nrhs) for i in 1..n] where fb(i,nrhs) == + labelList := + "append"/[fbb(i,j) for j in 1..nrhs] where fbb(i,j) == + bnam := INTERN STRCONC ('"b",STRINGIMAGE i,STRINGIMAGE j) + [['bcStrings, [6, 0, bnam, 'F]]] + prefix := ('"\newline ") + labelList := [['text,:prefix],:labelList] + prefix := ("\blankline \menuitemstyle{}\tab{2} Enter the matrix {\it B}: ") + bList := [['text,:prefix],:bList] + equationPart := [ + '(domainConditions + (isDomain EM $EmptyMode) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain I (Integer))) + ,:aList,:ipList,:bList] + page := htInitPage('"F07AEF - Solution of a real system of linear equations with multiple right-hand sides after factorization by F07ADF",nil) + htSay '"\menuitemstyle{}\tab{2} " + htSay '"Enter the matrix {\it A}:" + htSay '"\newline " + htMakePage equationPart + htMakeDoneButton('"Continue",'f07aefGen) + htpSetProperty(page,'n,n) +-- htpSetProperty(page,'m,m) + htpSetProperty(page,'nrhs,nrhs) +-- htpSetProperty(page,'lda,lda) +-- htpSetProperty(page,'ldb,ldb) + htpSetProperty(page,'trans,trans) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +f07aefDefaultSolve (htPage,trans) == + n := '4 + nrhs := '2 + lda := '4 + ldb := '4 + length := '4 + page := htInitPage('"F07AEF - Solution of a real system of linear equations with multiple right-hand sides after factorization by F07ADF",nil) + htMakePage '( + (domainConditions + (isDomain EM $EmptyMode) + (isDomain F (Float)) + (isDomain I (Integer))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the matrix {\it A}:") + (text . "\newline ") + (bcStrings (5 "5.25" a11 F)) + (bcStrings (5 "-2.95" a12 F)) + (bcStrings (5 "-0.95" a13 F)) + (bcStrings (5 "-3.8" a14 F)) + (text . "\newline ") + (bcStrings (5 "0.34" a21 F)) + (bcStrings (5 "3.89" a22 F)) + (bcStrings (5 "2.38" a23 F)) + (bcStrings (5 "0.41" a24 F)) + (text . "\newline ") + (bcStrings (5 "0.3" a31 F)) + (bcStrings (5 "-0.46" a32 F)) + (bcStrings (5 "-1.51" a33 F)) + (bcStrings (5 "0.29" a34 F)) + (text . "\newline ") + (bcStrings (5 "-0.21" a41 F)) + (bcStrings (5 "-0.33" a42 F)) + (bcStrings (5 "0.00" a43 F)) + (bcStrings (5 "0.13" a44 F)) + (text . "\newline ") + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the pivot indices {\it IPIV} from F07ADF: ") + (text . "\newline ") + (bcStrings (5 2 ip1 PI)) + (bcStrings (5 2 ip2 PI)) + (bcStrings (5 3 ip3 PI)) + (bcStrings (5 4 ip4 PI)) + (text . "\newline ") + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the matrix {\it B}:") + (text . "\newline ") + (bcStrings (5 "9.52" b11 F)) + (bcStrings (5 "18.47" b12 F)) + (text . "\newline ") + (bcStrings (5 "24.35" b21 F)) + (bcStrings (5 "2.25" b22 F)) + (text . "\newline ") + (bcStrings (5 "0.77" b31 F)) + (bcStrings (5 "-13.28" b32 F)) + (text . "\newline ") + (bcStrings (5 "-6.22" b41 F)) + (bcStrings (5 "-6.21" b42 F))) + htpSetProperty(page,'trans,trans) + htpSetProperty(page,'n,n) + htpSetProperty(page,'nrhs,nrhs) +-- htpSetProperty(page,'lda,lda) +-- htpSetProperty(page,'ldb,ldb) + htpSetProperty(page,'length,length) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htMakeDoneButton('"Continue",'f07aefGen) + htShowPage() + +f07aefGen htPage == + n := htpProperty(htPage, 'n) + nrhs := htpProperty(htPage, 'nrhs) +-- lda := htpProperty(htPage, 'lda) +-- ldb := htpProperty(htPage, 'ldb) + lda := n + ldb := n + length := htpProperty(htPage, 'length) + trans := htpProperty(htPage,'trans) + aplist := htpInputAreaAlist htPage + y := aplist + for i in 1..n repeat + for j in 1..nrhs repeat + b := STRCONC((first y).1," ") + rowList := [b,:rowList] + y := rest y + bList := [rowList,:bList] + rowList := [] + bstring := bcwords2liststring [bcwords2liststring x for x in bList] + for i in 1..length repeat + ip := STRCONC((first y).1," ") + ipList := [ip,:ipList] + y := rest y + ipstring := bcwords2liststring ipList + for i in 1..lda repeat + for j in 1..n repeat + a := STRCONC((first y).1," ") + rowList := [a,:rowList] + y := rest y + aList := [rowList,:aList] + rowList := [] + astring := bcwords2liststring [bcwords2liststring x for x in aList] + prefix := STRCONC("f07aef(_"", trans,"_", ",STRINGIMAGE n,", ") + prefix := STRCONC(prefix,STRINGIMAGE nrhs,", ",astring,"::Matrix DoubleFloat, ") + prefix := STRCONC(prefix,STRINGIMAGE lda,", [",ipstring,"]::Matrix INT, ") + prefix := STRCONC(prefix,STRINGIMAGE ldb,", ",bstring,"::Matrix DoubleFloat)") + linkGen prefix + +f07fdf() == + htInitPage('"F07FDF - Cholesky factorization of a real symmmetric positive-definite matrix {\it A}",nil) + htMakePage '( + (domainConditions + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXf07fdf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f07fdf| '|NagLapack|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\newline ") + (text . "F07FDF computes the Cholesky factorization of a real symmetric positive-definite ") + (text . "matrix {\it A} ") + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Method of factorization of {\it A}, {\it UPLO}:") + (text . "\blankline ") + (radioButtons uplo + ("" " L, {\it A} factorized as lower triangular" lower) + ("" " U, {\it A} factorized as upper triangular" upper)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "The order {\it n} of {\it A}: ") + (text . "\newline ") + (bcStrings (5 4 n PI)) +-- (text . "\blankline ") +-- (text . "\menuitemstyle{}\tab{2}") +-- (text . "First dimension of {\it A}, {\it lda}:") +-- (text . "\newline ") +-- (bcStrings (5 4 lda PI))) + ) + htMakeDoneButton('"Continue", 'f07fdfSolve) + htShowPage() + +f07fdfSolve htPage == + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + lda := n +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lda) +-- objValUnwrap htpLabelSpadValue(htPage, 'lda) + upl := htpButtonValue(htPage, 'uplo) + uplo:= + upl = 'lower => '"L" + '"U" + (n = '4 ) => f07fdfDefaultSolve(htPage,uplo) + aList := + "append"/[fa(i,n) for i in 1..lda] 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, [6, 0, anam, 'F]]] + prefix := ('"\newline ") + labelList := [['text,:prefix],:labelList] + equationPart := [ + '(domainConditions + (isDomain EM $EmptyMode) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain I (Integer))), + :aList] + page := htInitPage('"F07FDF - Cholesky factorization of a real symmmetric positive-definite matrix {\it A}",nil) + htSay '"\menuitemstyle{}\tab{2} " + htSay '"Enter the matrix {\it A}:" + htSay '"\newline " + htMakePage equationPart + htMakeDoneButton('"Continue",'f07fdfGen) + htpSetProperty(page,'uplo,uplo) + htpSetProperty(page,'n,n) +-- htpSetProperty(page,'lda,lda) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +f07fdfDefaultSolve (htPage,uplo) == + n := '4 + lda := '4 + page := htInitPage('"F07FDF - Cholesky factorization of a real symmmetric positive-definite matrix {\it A}",nil) + htMakePage '( + (domainConditions + (isDomain EM $EmptyMode) + (isDomain F (Float)) + (isDomain I (Integer))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the matrix {\it A}:") + (text . "\newline ") + (bcStrings (5 "4.16" a11 F)) + (bcStrings (5 "0.0" a12 F)) + (bcStrings (5 "0.0" a13 F)) + (bcStrings (5 "0.0" a14 F)) + (text . "\newline ") + (bcStrings (5 "-3.12" a21 F)) + (bcStrings (5 "5.03" a22 F)) + (bcStrings (5 "0.0" a23 F)) + (bcStrings (5 "0.0" a24 F)) + (text . "\newline ") + (bcStrings (5 "0.56" a31 F)) + (bcStrings (5 "-0.83" a32 F)) + (bcStrings (5 "0.76" a33 F)) + (bcStrings (5 "0.0" a34 F)) + (text . "\newline ") + (bcStrings (5 "-0.1" a41 F)) + (bcStrings (5 "1.18" a42 F)) + (bcStrings (5 "0.34" a43 F)) + (bcStrings (5 "1.18" a44 F))) + htpSetProperty(page,'uplo,uplo) + htpSetProperty(page,'n,n) +-- htpSetProperty(page,'lda,lda) + htMakeDoneButton('"Continue",'f07fdfGen) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +f07fdfGen htPage == + n := htpProperty(htPage, 'n) +-- lda := htpProperty(htPage, 'lda) + lda := n + uplo := htpProperty(htPage,'uplo) + alist := htpInputAreaAlist htPage + y := alist + for i in 1..n repeat + for j in 1..n repeat + a := STRCONC((first y).1," ") + rowList := [a,:rowList] + y := rest y + aList := [rowList,:aList] + rowList := [] + astring := bcwords2liststring [bcwords2liststring x for x in aList] + prefix := STRCONC("f07fdf(_"", uplo,"_", ",STRINGIMAGE n,", ") + prefix := STRCONC(prefix,STRINGIMAGE lda,", ",astring,")") + linkGen prefix + + +f07fef() == + htInitPage('"F07FEF - Solution of a real symmetric positive-definite system of linear equations with multiple right-hand sides after factorization by F07FDF",nil) + htMakePage '( + (domainConditions + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXf07fef} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f07fef| '|NagLapack|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\newline ") + (text . "F07FEF solves a real symmetric positive-definite system of linear ") + (text . "equations with multiple right-hand sides, {\it AX=B}, where ") + (text . "{\it A} has been factorized by F07FDF ") + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Method of factorization of {\it A}, {\it UPLO}:") + (text . "\blankline ") + (radioButtons uplo + ("" " L, {\it A} factorized as lower triangular" lower) + ("" " U, {\it A} factorized as upper triangular" upper)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "The order {\it n} of {\it A}: ") + (text . "\newline ") + (bcStrings (5 4 n PI)) + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "The number of right-hand sides, {\it nrhs}: ") + (text . "\newline ") + (bcStrings (5 2 nrhs PI)) +-- (text . "\blankline ") +-- (text . "\menuitemstyle{}\tab{2}") +-- (text . "First dimension of {\it A}, {\it lda}: ") +-- (text . "\newline ") +-- (bcStrings (5 4 lda PI)) +-- (text . "\blankline ") +-- (text . "\menuitemstyle{}\tab{2}") +-- (text . "First dimension of {\it B}, {\it ldb}: ") +-- (text . "\newline ") +-- (bcStrings (5 4 ldb PI))) + ) + htMakeDoneButton('"Continue", 'f07fefSolve) + htShowPage() + +f07fefSolve htPage == + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + nrhs := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nrhs) + objValUnwrap htpLabelSpadValue(htPage, 'nrhs) + lda := n +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lda) +-- objValUnwrap htpLabelSpadValue(htPage, 'lda) + ldb := n +-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ldb) +-- objValUnwrap htpLabelSpadValue(htPage, 'ldb) + upl := htpButtonValue(htPage, 'uplo) + uplo:= + upl = 'lower => '"L" + '"U" + (n = '4 and nrhs = '2) => f07fefDefaultSolve(htPage,uplo) + aList := + "append"/[fa(i,n) for i in 1..lda] where fa(i,n) == + labelList := + "append"/[faa(i,j) for j in 1..n] where faa(i,j) == + anam := INTERN STRCONC ('"a",STRINGIMAGE i,STRINGIMAGE j) + [['bcStrings, [8, 0, anam, 'F]]] + prefix := ('"\newline ") + labelList := [['text,:prefix],:labelList] + bList := + "append"/[fb(i,nrhs) for i in 1..n] where fb(i,nrhs) == + labelList := + "append"/[fbb(i,j) for j in 1..nrhs] where fbb(i,j) == + bnam := INTERN STRCONC ('"b",STRINGIMAGE i,STRINGIMAGE j) + [['bcStrings, [8, 0, bnam, 'F]]] + prefix := ('"\newline ") + labelList := [['text,:prefix],:labelList] + prefix := ("\blankline \menuitemstyle{}\tab{2} Enter the matrix {\it B}: ") + bList := [['text,:prefix],:bList] + equationPart := [ + '(domainConditions + (isDomain EM $EmptyMode) + (isDomain S (String)) + (isDomain F (Float)) + (isDomain I (Integer))) + ,:aList,:bList] + page := htInitPage('"F07FEF - Solution of a real symmetric positive-definite system of linear equations with multiple right-hand sides after factorization by F07FDF",nil) + htSay '"\menuitemstyle{}\tab{2} " + htSay '"Enter the matrix {\it A}:" + htSay '"\newline " + htMakePage equationPart + htMakeDoneButton('"Continue",'f07fefGen) + htpSetProperty(page,'uplo,uplo) + htpSetProperty(page,'n,n) + htpSetProperty(page,'nrhs,nrhs) +-- htpSetProperty(page,'lda,lda) +-- htpSetProperty(page,'ldb,ldb) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htShowPage() + +f07fefDefaultSolve (htPage,uplo) == + n := '4 + nrhs := '2 + lda := '4 + ldb := '4 + page := htInitPage('"F07FEF - Solution of a real symmetric positive-definite system of linear equations with multiple right-hand sides after factorization by F07FDF",nil) + htMakePage '( + (domainConditions + (isDomain EM $EmptyMode) + (isDomain F (Float)) + (isDomain I (Integer))) + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the matrix {\it A}:") + (text . "\newline ") + (bcStrings (8 "2.04" a11 F)) + (bcStrings (8 "0.0" a12 F)) + (bcStrings (8 "0.0" a13 F)) + (bcStrings (8 "0.0" a14 F)) + (text . "\newline ") + (bcStrings (8 "-1.53" a21 F)) + (bcStrings (8 "1.64" a22 F)) + (bcStrings (8 "0.0" a23 F)) + (bcStrings (8 "0.0" a24 F)) + (text . "\newline ") + (bcStrings (8 "0.28" a31 F)) + (bcStrings (8 "-0.25" a32 F)) + (bcStrings (8 "0.79" a33 F)) + (bcStrings (8 "0.0" a34 F)) + (text . "\newline ") + (bcStrings (8 "-0.05" a41 F)) + (bcStrings (8 "0.67" a42 F)) + (bcStrings (8 "0.66" a43 F)) + (bcStrings (8 "0.54" a44 F)) + (text . "\newline ") + (text . "\blankline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the matrix {\it B}:") + (text . "\newline ") + (bcStrings (8 "8.7" b11 F)) + (bcStrings (8 "8.3" b12 F)) + (text . "\newline ") + (bcStrings (8 "-13.35" b21 F)) + (bcStrings (8 "2.13" b22 F)) + (text . "\newline ") + (bcStrings (8 "1.89" b31 F)) + (bcStrings (8 "1.61" b32 F)) + (text . "\newline ") + (bcStrings (8 "-4.14" b41 F)) + (bcStrings (8 "5" b42 F))) + htpSetProperty(page,'uplo,uplo) + htpSetProperty(page,'n,n) + htpSetProperty(page,'nrhs,nrhs) +-- htpSetProperty(page,'lda,lda) +-- htpSetProperty(page,'ldb,ldb) + htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) + htMakeDoneButton('"Continue",'f07fefGen) + htShowPage() + +f07fefGen htPage == + n := htpProperty(htPage, 'n) + nrhs := htpProperty(htPage, 'nrhs) +-- lda := htpProperty(htPage, 'lda) +-- ldb := htpProperty(htPage, 'ldb) + lda := n + ldb := n + uplo := htpProperty(htPage,'uplo) + aplist := htpInputAreaAlist htPage + y := aplist + for i in 1..n repeat + for j in 1..nrhs repeat + b := STRCONC((first y).1," ") + rowList := [b,:rowList] + y := rest y + bList := [rowList,:bList] + rowList := [] + bstring := bcwords2liststring [bcwords2liststring x for x in bList] + for i in 1..lda repeat + for j in 1..n repeat + a := STRCONC((first y).1," ") + rowList := [a,:rowList] + y := rest y + aList := [rowList,:aList] + rowList := [] + astring := bcwords2liststring [bcwords2liststring x for x in aList] + prefix := STRCONC("f07fef(_"", uplo,"_", ",STRINGIMAGE n,", ") + prefix := STRCONC(prefix,STRINGIMAGE nrhs,", ",astring,"::Matrix DoubleFloat, ") + prefix := STRCONC(prefix,STRINGIMAGE lda,", ") + prefix := STRCONC(prefix,STRINGIMAGE ldb,", ",bstring,"::Matrix DoubleFloat)") + linkGen prefix + diff --git a/src/interp/nag-f07.boot.pamphlet b/src/interp/nag-f07.boot.pamphlet deleted file mode 100644 index a2eb3b2d..00000000 --- a/src/interp/nag-f07.boot.pamphlet +++ /dev/null @@ -1,728 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp nag-f07.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. - -@ -<<*>>= -<> - -)package "BOOT" - -f07adf() == - htInitPage('"F07ADF - {\it LU} factorization of real {\it m} by {\it n} matrix",nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXf07adf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f07adf| '|NagLapack|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "F07ADF computes the {\it LU} factorization of a real {\it m}") - (text . " by {\it n} matrix ") - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Number of rows {\it m}:") - (text . "\newline\tab{2} ") - (bcStrings (5 4 m PI)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Number of columns {\it n}:") - (text . "\newline\tab{2} ") - (bcStrings (5 4 n PI)) - ) --- (text . "\blankline ") --- (text . "\menuitemstyle{}\tab{2}") --- (text . "First dimension of array A, {\it lda}:") --- (text . "\newline\tab{2} ") --- (bcStrings (5 4 lda PI)) - htMakeDoneButton('"Continue", 'f07adfSolve) - htShowPage() - -f07adfSolve htPage == - m := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) - objValUnwrap htpLabelSpadValue(htPage, 'm) - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - lda := m - (n = '4 and m = '4) => f07adfDefaultSolve(htPage,lda) - aList := - "append"/[fa(i,n) for i in 1..m] 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,[6, 0, anam, 'F]]] - prefix := ('"\newline ") - labelList := [['text,:prefix],:labelList] - equationPart := [ - '(domainConditions - (isDomain EM $EmptyMode) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain I (Integer))), - :aList] - page := htInitPage('"F07ADF - {\it LU} factorization of real {\it m} by {\it n} matrix",nil) - htSay '"\menuitemstyle{}\tab{2} " - htSay '"Enter the array {\it A}:" - htSay '"\newline " - htMakePage equationPart - htMakeDoneButton('"Continue",'f07adfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) --- htpSetProperty(page,'lda,lda) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f07adfDefaultSolve (htPage,lda) == - n := '4 - m := '4 - page := htInitPage('"F07ADF - {\it LU} factorization of real {\it m} by {\it n} matrix",nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the array {\it A}:") - (text . "\newline ") - (bcStrings (5 "1.8" a11 F)) - (bcStrings (5 "2.88" a12 F)) - (bcStrings (5 "2.05" a13 F)) - (bcStrings (5 "-0.89" a14 F)) - (text . "\newline ") - (bcStrings (5 "5.25" a21 F)) - (bcStrings (5 "-2.95" a22 F)) - (bcStrings (5 "-0.95" a23 F)) - (bcStrings (5 "-3.8" a24 F)) - (text . "\newline ") - (bcStrings (5 "1.58" a31 F)) - (bcStrings (5 "-2.69" a32 F)) - (bcStrings (5 "-2.9" a33 F)) - (bcStrings (5 "-1.04" a34 F)) - (text . "\newline ") - (bcStrings (5 "-1.11" a41 F)) - (bcStrings (5 "-0.66" a42 F)) - (bcStrings (5 "-0.59" a43 F)) - (bcStrings (5 "0.8" a44 F))) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) --- htpSetProperty(page,'lda,lda) - htMakeDoneButton('"Continue",'f07adfGen) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f07adfGen htPage == - n := htpProperty(htPage, 'n) - m := htpProperty(htPage, 'm) - lda := m - alist := htpInputAreaAlist htPage - y := alist - for i in 1..n repeat - for j in 1..m repeat - a := STRCONC((first y).1," ") - rowList := [a,:rowList] - y := rest y - aList := [rowList,:aList] - rowList := [] - astring := bcwords2liststring [bcwords2liststring x for x in aList] - prefix := STRCONC("f07adf(",STRINGIMAGE m,", ",STRINGIMAGE n,", ") - prefix := STRCONC(prefix,STRINGIMAGE lda,", ",astring,")") - linkGen prefix - - -f07aef() == - htInitPage('"F07AEF - Solution of a real system of linear equations with multiple right-hand sides after factorization by F07ADF",nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXf07aef} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f07aef| '|NagLapack|)} for this routine") - (text . "\newline \horizontalline ") - (text . "F07AEF solves a real system of linear equations with multiple right-hand sides, {\it AX=B} or ") - (text . "\htbitmap{aTx=b} , where {\it a} has been factorized by F07ADF ") - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Form of the equations:") - (text . "\blankline ") - (radioButtons trans - ("" " N, the equations are {\it AX=B}" norm) - ("" " T, the equations are \htbitmap{aTx=b}" transp)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "The order {\it n} of {\it A}: ") - (text . "\newline ") - (bcStrings (5 4 n PI)) --- (text . "\blankline ") --- (text . "\menuitemstyle{}\tab{2}") --- (text . "The order {\it m} of {\it A} used by F07AEF: ") --- (text . "\newline ") --- (bcStrings (5 4 m PI)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "The number of right-hand sides, {\it nrhs}: ") - (text . "\newline ") - (bcStrings (5 2 nrhs PI)) --- (text . "\blankline ") --- (text . "\menuitemstyle{}\tab{2}") --- (text . "First dimension of {\it A}, {\it lda}: ") --- (text . "\newline ") --- (bcStrings (5 4 lda PI)) --- (text . "\blankline ") --- (text . "\menuitemstyle{}\tab{2}") --- (text . "First dimension of {\it B}, {\it ldb}: ") --- (text . "\newline ") --- (bcStrings (5 4 ldb PI)) - ) - htMakeDoneButton('"Continue", 'f07aefSolve) - htShowPage() - -f07aefSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) --- m := --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) --- objValUnwrap htpLabelSpadValue(htPage, 'm) - nrhs := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nrhs) - objValUnwrap htpLabelSpadValue(htPage, 'nrhs) - lda := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lda) --- objValUnwrap htpLabelSpadValue(htPage, 'lda) - ldb := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ldb) --- objValUnwrap htpLabelSpadValue(htPage, 'ldb) - equa := htpButtonValue(htPage, 'trans) - trans := - equa = 'norm => '"N" - '"T" - (n = '4 and nrhs = '2 ) => f07aefDefaultSolve (htPage,trans) - aList := - "append"/[fa(i,n) for i in 1..lda] where fa(i,n) == - labelList := - "append"/[faa(i,j) for j in 1..n] where faa(i,j) == - anam := INTERN STRCONC ('"a",STRINGIMAGE i,STRINGIMAGE j) - [['bcStrings, [6, 0, anam, 'F]]] - prefix := ('"\newline ") - labelList := [['text,:prefix],:labelList] - ipList := - [fp(i) for i in 1..n] where fp(i) == - ipnam := INTERN STRCONC ('"ip",STRINGIMAGE i) - ['bcStrings,[5, 0, ipnam, 'I]] - middle := ('"\blankline \menuitemstyle{}\tab{2} Enter the pivot ") - middle := STRCONC(middle,'"indices {\it IPIV} from F07ADF: ") - middle := STRCONC(middle,'"\newline ") - ipList := [['text,:middle],:ipList] - bList := - "append"/[fb(i,nrhs) for i in 1..n] where fb(i,nrhs) == - labelList := - "append"/[fbb(i,j) for j in 1..nrhs] where fbb(i,j) == - bnam := INTERN STRCONC ('"b",STRINGIMAGE i,STRINGIMAGE j) - [['bcStrings, [6, 0, bnam, 'F]]] - prefix := ('"\newline ") - labelList := [['text,:prefix],:labelList] - prefix := ("\blankline \menuitemstyle{}\tab{2} Enter the matrix {\it B}: ") - bList := [['text,:prefix],:bList] - equationPart := [ - '(domainConditions - (isDomain EM $EmptyMode) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain I (Integer))) - ,:aList,:ipList,:bList] - page := htInitPage('"F07AEF - Solution of a real system of linear equations with multiple right-hand sides after factorization by F07ADF",nil) - htSay '"\menuitemstyle{}\tab{2} " - htSay '"Enter the matrix {\it A}:" - htSay '"\newline " - htMakePage equationPart - htMakeDoneButton('"Continue",'f07aefGen) - htpSetProperty(page,'n,n) --- htpSetProperty(page,'m,m) - htpSetProperty(page,'nrhs,nrhs) --- htpSetProperty(page,'lda,lda) --- htpSetProperty(page,'ldb,ldb) - htpSetProperty(page,'trans,trans) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f07aefDefaultSolve (htPage,trans) == - n := '4 - nrhs := '2 - lda := '4 - ldb := '4 - length := '4 - page := htInitPage('"F07AEF - Solution of a real system of linear equations with multiple right-hand sides after factorization by F07ADF",nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the matrix {\it A}:") - (text . "\newline ") - (bcStrings (5 "5.25" a11 F)) - (bcStrings (5 "-2.95" a12 F)) - (bcStrings (5 "-0.95" a13 F)) - (bcStrings (5 "-3.8" a14 F)) - (text . "\newline ") - (bcStrings (5 "0.34" a21 F)) - (bcStrings (5 "3.89" a22 F)) - (bcStrings (5 "2.38" a23 F)) - (bcStrings (5 "0.41" a24 F)) - (text . "\newline ") - (bcStrings (5 "0.3" a31 F)) - (bcStrings (5 "-0.46" a32 F)) - (bcStrings (5 "-1.51" a33 F)) - (bcStrings (5 "0.29" a34 F)) - (text . "\newline ") - (bcStrings (5 "-0.21" a41 F)) - (bcStrings (5 "-0.33" a42 F)) - (bcStrings (5 "0.00" a43 F)) - (bcStrings (5 "0.13" a44 F)) - (text . "\newline ") - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the pivot indices {\it IPIV} from F07ADF: ") - (text . "\newline ") - (bcStrings (5 2 ip1 PI)) - (bcStrings (5 2 ip2 PI)) - (bcStrings (5 3 ip3 PI)) - (bcStrings (5 4 ip4 PI)) - (text . "\newline ") - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the matrix {\it B}:") - (text . "\newline ") - (bcStrings (5 "9.52" b11 F)) - (bcStrings (5 "18.47" b12 F)) - (text . "\newline ") - (bcStrings (5 "24.35" b21 F)) - (bcStrings (5 "2.25" b22 F)) - (text . "\newline ") - (bcStrings (5 "0.77" b31 F)) - (bcStrings (5 "-13.28" b32 F)) - (text . "\newline ") - (bcStrings (5 "-6.22" b41 F)) - (bcStrings (5 "-6.21" b42 F))) - htpSetProperty(page,'trans,trans) - htpSetProperty(page,'n,n) - htpSetProperty(page,'nrhs,nrhs) --- htpSetProperty(page,'lda,lda) --- htpSetProperty(page,'ldb,ldb) - htpSetProperty(page,'length,length) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htMakeDoneButton('"Continue",'f07aefGen) - htShowPage() - -f07aefGen htPage == - n := htpProperty(htPage, 'n) - nrhs := htpProperty(htPage, 'nrhs) --- lda := htpProperty(htPage, 'lda) --- ldb := htpProperty(htPage, 'ldb) - lda := n - ldb := n - length := htpProperty(htPage, 'length) - trans := htpProperty(htPage,'trans) - aplist := htpInputAreaAlist htPage - y := aplist - for i in 1..n repeat - for j in 1..nrhs repeat - b := STRCONC((first y).1," ") - rowList := [b,:rowList] - y := rest y - bList := [rowList,:bList] - rowList := [] - bstring := bcwords2liststring [bcwords2liststring x for x in bList] - for i in 1..length repeat - ip := STRCONC((first y).1," ") - ipList := [ip,:ipList] - y := rest y - ipstring := bcwords2liststring ipList - for i in 1..lda repeat - for j in 1..n repeat - a := STRCONC((first y).1," ") - rowList := [a,:rowList] - y := rest y - aList := [rowList,:aList] - rowList := [] - astring := bcwords2liststring [bcwords2liststring x for x in aList] - prefix := STRCONC("f07aef(_"", trans,"_", ",STRINGIMAGE n,", ") - prefix := STRCONC(prefix,STRINGIMAGE nrhs,", ",astring,"::Matrix DoubleFloat, ") - prefix := STRCONC(prefix,STRINGIMAGE lda,", [",ipstring,"]::Matrix INT, ") - prefix := STRCONC(prefix,STRINGIMAGE ldb,", ",bstring,"::Matrix DoubleFloat)") - linkGen prefix - -f07fdf() == - htInitPage('"F07FDF - Cholesky factorization of a real symmmetric positive-definite matrix {\it A}",nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXf07fdf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f07fdf| '|NagLapack|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "F07FDF computes the Cholesky factorization of a real symmetric positive-definite ") - (text . "matrix {\it A} ") - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Method of factorization of {\it A}, {\it UPLO}:") - (text . "\blankline ") - (radioButtons uplo - ("" " L, {\it A} factorized as lower triangular" lower) - ("" " U, {\it A} factorized as upper triangular" upper)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "The order {\it n} of {\it A}: ") - (text . "\newline ") - (bcStrings (5 4 n PI)) --- (text . "\blankline ") --- (text . "\menuitemstyle{}\tab{2}") --- (text . "First dimension of {\it A}, {\it lda}:") --- (text . "\newline ") --- (bcStrings (5 4 lda PI))) - ) - htMakeDoneButton('"Continue", 'f07fdfSolve) - htShowPage() - -f07fdfSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - lda := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lda) --- objValUnwrap htpLabelSpadValue(htPage, 'lda) - upl := htpButtonValue(htPage, 'uplo) - uplo:= - upl = 'lower => '"L" - '"U" - (n = '4 ) => f07fdfDefaultSolve(htPage,uplo) - aList := - "append"/[fa(i,n) for i in 1..lda] 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, [6, 0, anam, 'F]]] - prefix := ('"\newline ") - labelList := [['text,:prefix],:labelList] - equationPart := [ - '(domainConditions - (isDomain EM $EmptyMode) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain I (Integer))), - :aList] - page := htInitPage('"F07FDF - Cholesky factorization of a real symmmetric positive-definite matrix {\it A}",nil) - htSay '"\menuitemstyle{}\tab{2} " - htSay '"Enter the matrix {\it A}:" - htSay '"\newline " - htMakePage equationPart - htMakeDoneButton('"Continue",'f07fdfGen) - htpSetProperty(page,'uplo,uplo) - htpSetProperty(page,'n,n) --- htpSetProperty(page,'lda,lda) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f07fdfDefaultSolve (htPage,uplo) == - n := '4 - lda := '4 - page := htInitPage('"F07FDF - Cholesky factorization of a real symmmetric positive-definite matrix {\it A}",nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the matrix {\it A}:") - (text . "\newline ") - (bcStrings (5 "4.16" a11 F)) - (bcStrings (5 "0.0" a12 F)) - (bcStrings (5 "0.0" a13 F)) - (bcStrings (5 "0.0" a14 F)) - (text . "\newline ") - (bcStrings (5 "-3.12" a21 F)) - (bcStrings (5 "5.03" a22 F)) - (bcStrings (5 "0.0" a23 F)) - (bcStrings (5 "0.0" a24 F)) - (text . "\newline ") - (bcStrings (5 "0.56" a31 F)) - (bcStrings (5 "-0.83" a32 F)) - (bcStrings (5 "0.76" a33 F)) - (bcStrings (5 "0.0" a34 F)) - (text . "\newline ") - (bcStrings (5 "-0.1" a41 F)) - (bcStrings (5 "1.18" a42 F)) - (bcStrings (5 "0.34" a43 F)) - (bcStrings (5 "1.18" a44 F))) - htpSetProperty(page,'uplo,uplo) - htpSetProperty(page,'n,n) --- htpSetProperty(page,'lda,lda) - htMakeDoneButton('"Continue",'f07fdfGen) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f07fdfGen htPage == - n := htpProperty(htPage, 'n) --- lda := htpProperty(htPage, 'lda) - lda := n - uplo := htpProperty(htPage,'uplo) - alist := htpInputAreaAlist htPage - y := alist - for i in 1..n repeat - for j in 1..n repeat - a := STRCONC((first y).1," ") - rowList := [a,:rowList] - y := rest y - aList := [rowList,:aList] - rowList := [] - astring := bcwords2liststring [bcwords2liststring x for x in aList] - prefix := STRCONC("f07fdf(_"", uplo,"_", ",STRINGIMAGE n,", ") - prefix := STRCONC(prefix,STRINGIMAGE lda,", ",astring,")") - linkGen prefix - - -f07fef() == - htInitPage('"F07FEF - Solution of a real symmetric positive-definite system of linear equations with multiple right-hand sides after factorization by F07FDF",nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXf07fef} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f07fef| '|NagLapack|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "F07FEF solves a real symmetric positive-definite system of linear ") - (text . "equations with multiple right-hand sides, {\it AX=B}, where ") - (text . "{\it A} has been factorized by F07FDF ") - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Method of factorization of {\it A}, {\it UPLO}:") - (text . "\blankline ") - (radioButtons uplo - ("" " L, {\it A} factorized as lower triangular" lower) - ("" " U, {\it A} factorized as upper triangular" upper)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "The order {\it n} of {\it A}: ") - (text . "\newline ") - (bcStrings (5 4 n PI)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "The number of right-hand sides, {\it nrhs}: ") - (text . "\newline ") - (bcStrings (5 2 nrhs PI)) --- (text . "\blankline ") --- (text . "\menuitemstyle{}\tab{2}") --- (text . "First dimension of {\it A}, {\it lda}: ") --- (text . "\newline ") --- (bcStrings (5 4 lda PI)) --- (text . "\blankline ") --- (text . "\menuitemstyle{}\tab{2}") --- (text . "First dimension of {\it B}, {\it ldb}: ") --- (text . "\newline ") --- (bcStrings (5 4 ldb PI))) - ) - htMakeDoneButton('"Continue", 'f07fefSolve) - htShowPage() - -f07fefSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - nrhs := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nrhs) - objValUnwrap htpLabelSpadValue(htPage, 'nrhs) - lda := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lda) --- objValUnwrap htpLabelSpadValue(htPage, 'lda) - ldb := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ldb) --- objValUnwrap htpLabelSpadValue(htPage, 'ldb) - upl := htpButtonValue(htPage, 'uplo) - uplo:= - upl = 'lower => '"L" - '"U" - (n = '4 and nrhs = '2) => f07fefDefaultSolve(htPage,uplo) - aList := - "append"/[fa(i,n) for i in 1..lda] where fa(i,n) == - labelList := - "append"/[faa(i,j) for j in 1..n] where faa(i,j) == - anam := INTERN STRCONC ('"a",STRINGIMAGE i,STRINGIMAGE j) - [['bcStrings, [8, 0, anam, 'F]]] - prefix := ('"\newline ") - labelList := [['text,:prefix],:labelList] - bList := - "append"/[fb(i,nrhs) for i in 1..n] where fb(i,nrhs) == - labelList := - "append"/[fbb(i,j) for j in 1..nrhs] where fbb(i,j) == - bnam := INTERN STRCONC ('"b",STRINGIMAGE i,STRINGIMAGE j) - [['bcStrings, [8, 0, bnam, 'F]]] - prefix := ('"\newline ") - labelList := [['text,:prefix],:labelList] - prefix := ("\blankline \menuitemstyle{}\tab{2} Enter the matrix {\it B}: ") - bList := [['text,:prefix],:bList] - equationPart := [ - '(domainConditions - (isDomain EM $EmptyMode) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain I (Integer))) - ,:aList,:bList] - page := htInitPage('"F07FEF - Solution of a real symmetric positive-definite system of linear equations with multiple right-hand sides after factorization by F07FDF",nil) - htSay '"\menuitemstyle{}\tab{2} " - htSay '"Enter the matrix {\it A}:" - htSay '"\newline " - htMakePage equationPart - htMakeDoneButton('"Continue",'f07fefGen) - htpSetProperty(page,'uplo,uplo) - htpSetProperty(page,'n,n) - htpSetProperty(page,'nrhs,nrhs) --- htpSetProperty(page,'lda,lda) --- htpSetProperty(page,'ldb,ldb) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f07fefDefaultSolve (htPage,uplo) == - n := '4 - nrhs := '2 - lda := '4 - ldb := '4 - page := htInitPage('"F07FEF - Solution of a real symmetric positive-definite system of linear equations with multiple right-hand sides after factorization by F07FDF",nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the matrix {\it A}:") - (text . "\newline ") - (bcStrings (8 "2.04" a11 F)) - (bcStrings (8 "0.0" a12 F)) - (bcStrings (8 "0.0" a13 F)) - (bcStrings (8 "0.0" a14 F)) - (text . "\newline ") - (bcStrings (8 "-1.53" a21 F)) - (bcStrings (8 "1.64" a22 F)) - (bcStrings (8 "0.0" a23 F)) - (bcStrings (8 "0.0" a24 F)) - (text . "\newline ") - (bcStrings (8 "0.28" a31 F)) - (bcStrings (8 "-0.25" a32 F)) - (bcStrings (8 "0.79" a33 F)) - (bcStrings (8 "0.0" a34 F)) - (text . "\newline ") - (bcStrings (8 "-0.05" a41 F)) - (bcStrings (8 "0.67" a42 F)) - (bcStrings (8 "0.66" a43 F)) - (bcStrings (8 "0.54" a44 F)) - (text . "\newline ") - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the matrix {\it B}:") - (text . "\newline ") - (bcStrings (8 "8.7" b11 F)) - (bcStrings (8 "8.3" b12 F)) - (text . "\newline ") - (bcStrings (8 "-13.35" b21 F)) - (bcStrings (8 "2.13" b22 F)) - (text . "\newline ") - (bcStrings (8 "1.89" b31 F)) - (bcStrings (8 "1.61" b32 F)) - (text . "\newline ") - (bcStrings (8 "-4.14" b41 F)) - (bcStrings (8 "5" b42 F))) - htpSetProperty(page,'uplo,uplo) - htpSetProperty(page,'n,n) - htpSetProperty(page,'nrhs,nrhs) --- htpSetProperty(page,'lda,lda) --- htpSetProperty(page,'ldb,ldb) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htMakeDoneButton('"Continue",'f07fefGen) - htShowPage() - -f07fefGen htPage == - n := htpProperty(htPage, 'n) - nrhs := htpProperty(htPage, 'nrhs) --- lda := htpProperty(htPage, 'lda) --- ldb := htpProperty(htPage, 'ldb) - lda := n - ldb := n - uplo := htpProperty(htPage,'uplo) - aplist := htpInputAreaAlist htPage - y := aplist - for i in 1..n repeat - for j in 1..nrhs repeat - b := STRCONC((first y).1," ") - rowList := [b,:rowList] - y := rest y - bList := [rowList,:bList] - rowList := [] - bstring := bcwords2liststring [bcwords2liststring x for x in bList] - for i in 1..lda repeat - for j in 1..n repeat - a := STRCONC((first y).1," ") - rowList := [a,:rowList] - y := rest y - aList := [rowList,:aList] - rowList := [] - astring := bcwords2liststring [bcwords2liststring x for x in aList] - prefix := STRCONC("f07fef(_"", uplo,"_", ",STRINGIMAGE n,", ") - prefix := STRCONC(prefix,STRINGIMAGE nrhs,", ",astring,"::Matrix DoubleFloat, ") - prefix := STRCONC(prefix,STRINGIMAGE lda,", ") - prefix := STRCONC(prefix,STRINGIMAGE ldb,", ",bstring,"::Matrix DoubleFloat)") - linkGen prefix - -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/nag-s.boot b/src/interp/nag-s.boot new file mode 100644 index 00000000..e2eed84a --- /dev/null +++ b/src/interp/nag-s.boot @@ -0,0 +1,1584 @@ +-- 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. + + +)package "BOOT" + +s01eaf() == + page := htInitPage("S01EAF - Complex exponential {\em exp(z)} ",nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\windowlink{Manual Page}{manpageXXs01eaf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s01eaf| '|NagSpecialFunctionsPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\newline ") + (text . "Evaluates the exponential function, exp(z), for complex z. ") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Real part of {\it z}:") + (text . "\tab{32} \menuitemstyle{}\tab{34}") + (text . "Imaginary part of {\it z}:") + (text . "\newline \tab{2} ") + (bcStrings (10 "-0.5" x F)) + (text . "\tab{34} ") + (bcStrings (10 "2.0" y 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", 's01eafGen) + htShowPage() + +s01eafGen htPage == + x := htpLabelInputString(htPage,'x) + y := htpLabelInputString(htPage,'y) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => 1 + -1 + linkGen STRCONC('"s01eaf(complex(",x,",",y,"),",STRINGIMAGE ifail,")") + + + +s13aaf() == + page := htInitPage("S13AAF - Exponential integral \htbitmap{s13aaf2}", nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\windowlink{Manual Page}{manpageXXs13aaf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s13aaf| '|NagSpecialFunctionsPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\blankline ") + (text . "Evaluates the exponential integral \vspace{-32} ") + (text . "\htbitmap{s13aaf1} ") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the argument x > 0.0: ") + (text . "\newline\tab{2} ") + (bcStrings (9 "2.0" x 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", 'sGen) + htpSetProperty(page,'routine,"s13aaf") + htShowPage() + +s13acf() == + page := htInitPage("S13ACF - Cosine integral {\em Ci(x)} ",nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\windowlink{Manual Page}{manpageXXs13acf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s13acf| '|NagSpecialFunctionsPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\blankline ") + (text . "Evaluates the cosine integral \space{1} ") + (text . "\htbitmap{s13acf} ") + (text . ", where \gamma denotes Euler's constant. ") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the argument x > 0.0: ") + (text . "\newline\tab{2} ") + (bcStrings (9 "0.2" x 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", 'sGen) + htpSetProperty(page,'routine,"s13acf") + htShowPage() + +s13adf() == + page := htInitPage("S13ADF - Sine integral Si(x) ",nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\windowlink{Manual Page}{manpageXXs13adf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s13adf| '|NagSpecialFunctionsPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\blankline ") + (text . "Evaluates the sine integral \space{1} \vspace{-32} ") + (text . "\inputbitmap{\htbmdir{}/s13adf.bitmap} \vspace{-37}. ") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the argument x: ") + (text . "\newline\tab{2} ") + (bcStrings (9 "0.2" x 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", 'sGen) + htpSetProperty(page,'routine,"s13adf") + htShowPage() + +s14aaf() == + page := htInitPage("S14AAF - Gamma Function \Gamma(x) ",nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\windowlink{Manual Page}{manpageXXs14aaf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s14aaf| '|NagSpecialFunctionsPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\blankline ") + (text . "Evaluates the gamma function, {\em Gamma(x)}. ") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the argument x > 0.0: ") + (text . "\newline\tab{2} ") + (bcStrings (9 "1.25" x 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", 'sGen) + htpSetProperty(page,'routine,"s14aaf") + htShowPage() + +s14abf() == + page := htInitPage("S14ABF - Log Gamma Function \Gamma(x) ",nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\windowlink{Manual Page}{manpageXXs14abf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s14abf| '|NagSpecialFunctionsPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\blankline ") + (text . "Evaluates the logarithm of the gamma function, ") + (text . "{\em ln Gamma(x)}. ") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the argument x > 0.0: ") + (text . "\newline\tab{2} ") + (bcStrings (9 "1.25" x 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", 'sGen) + htpSetProperty(page,'routine,"s14abf") + htShowPage() + +s14baf() == + htInitPage("S14BAF - Incomplete Gamma Functions P(a,x) & Q(a,x)",nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\windowlink{Manual Page}{manpageXXs14baf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s14baf| '|NagSpecialFunctionsPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\blankline ") + (text . "Evaluates the incomplete gamma functions, \space{1} ") + (text . "\vspace{-32} \inputbitmap{\htbmdir{}/s14baf.bitmap} \vspace{-37}, ") + (text . "which are normalised such that P(a,x) + Q(a,x) = 1. ") + (text . "\blankline ") + (text . "\newline ") + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} ") + (text . "Enter the value of {\em a}: > 0.0") + (text . "\tab{32} \menuitemstyle{}\tab{34} ") + (text . "Enter the value of {\em x}: >= 0.0 ") + (text . "\newline\tab{2} ") + (bcStrings (10 "2.0" a F)) + (text . "\tab{34} ") + (bcStrings (10 "3.0" x F)) + (text . "\blankline") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the tolerance:") + (text . "\newline\tab{2} ") + (bcStrings (30 "1.1102230246251600E-16" tol 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", 's14bafGen) + htShowPage() + +s14bafGen htPage == + a := htpLabelInputString(htPage,'a) + x := htpLabelInputString(htPage,'x) + tol := htpLabelInputString(htPage,'tol) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => 1 + -1 + linkGen STRCONC('"s14baf(",a,",",x,",",tol,",",STRINGIMAGE ifail,")") + +s15adf() == + page := htInitPage("S15ADF - Complement of error function erfc x",nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\windowlink{Manual Page}{manpageXXs15adf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s15adf| '|NagSpecialFunctionsPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\blankline ") + (text . "Evaluates the complementary gamma functions, erfc x = ") + (text . "\space{1} \vspace{-32} \inputbitmap{\htbmdir{}/s15adf.bitmap} ") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the argument x: ") + (text . "\newline\tab{2} ") + (bcStrings (9 "-10.0" x 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", 'sGen) + htpSetProperty(page,'routine,"s15adf") + htShowPage() + +s15aef() == + page := htInitPage("S15AEF - Error Function erf x", nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\windowlink{Manual Page}{manpageXXs15aef} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s15aef| '|NagSpecialFunctionsPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\blankline ") + (text . "Evaluates the error function, erf x = \space{1} ") + (text . "\vspace{-32} \inputbitmap{\htbmdir{}/s15aef.bitmap} ") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the argument x: ") + (text . "\newline\tab{2} ") + (bcStrings (9 "-6.0" x 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", 'sGen) + htpSetProperty(page,'routine,"s15aef") + htShowPage() + +s17acf() == + page := htInitPage("S17ACF - Bessel Function \space{1} \htbitmap{s17acf}", nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\windowlink{Manual Page}{manpageXXs17acf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s17acf| '|NagSpecialFunctionsPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\blankline ") + (text . "Evaluates the Bessel function \space{1} \htbitmap{s17acf}") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the argument x > 0.0: ") + (text . "\newline\tab{2} ") + (bcStrings (9 "0.5" x 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", 'sGen) + htpSetProperty(page,'routine,"s17acf") + htShowPage() + +s17adf() == + page := htInitPage("S17ADF - Bessel Function \space{1} \htbitmap{s17adf}", nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\windowlink{Manual Page}{manpageXXs17adf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s17adf| '|NagSpecialFunctionsPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\blankline ") + (text . "Evaluates the Bessel function \space{1} \htbitmap{s17adf}") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the argument x > 0.0: ") + (text . "\newline\tab{2} ") + (bcStrings (9 "0.5" x 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", 'sGen) + htpSetProperty(page,'routine,"s17adf") + htShowPage() + +s17aef() == + page := htInitPage("S17AEF - Bessel Function \space{1} \htbitmap{s17aef}", nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\windowlink{Manual Page}{manpageXXs17aef} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s17aef| '|NagSpecialFunctionsPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\blankline ") + (text . "Evaluates the Bessel function \space{1}") + (text . "\htbitmap{s17aef}") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the argument x > 0.0: ") + (text . "\newline\tab{2} ") + (bcStrings (9 "0.5" x 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", 'sGen) + htpSetProperty(page,'routine,"s17aef") + htShowPage() + +s17aff() == + page := htInitPage("S17AFF - Bessel Function \space{1} \htbitmap{s17aff}", nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\windowlink{Manual Page}{manpageXXs17aff} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s17aff| '|NagSpecialFunctionsPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\blankline ") + (text . "Evaluates the Bessel function \space{1} \htbitmap{s17aff}") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the argument x: ") + (text . "\newline\tab{2} ") + (bcStrings (9 "0.5" x 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", 'sGen) + htpSetProperty(page,'routine,"s17aff") + htShowPage() + +s17agf() == + page := htInitPage("S17AGF - Airy Function {\em Ai(x)}", nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\windowlink{Manual Page}{manpageXXs17agf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s17agf| '|NagSpecialFunctionsPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\blankline ") + (text . "Evaluates the Airy function {\em Ai(x)} ") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the argument x: ") + (text . "\newline\tab{2} ") + (bcStrings (9 "-10.0" x 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", 'sGen) + htpSetProperty(page,'routine,"s17agf") + htShowPage() + +s17ahf() == + page := htInitPage("S17AHF - Airy Function {\em Bi(x)}", nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\windowlink{Manual Page}{manpageXXs17ahf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s17ahf| '|NagSpecialFunctionsPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\blankline ") + (text . "Evaluates the Airy function {\em Bi(x)} ") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the argument x: ") + (text . "\newline\tab{2} ") + (bcStrings (9 "-10.0" x 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", 'sGen) + htpSetProperty(page,'routine,"s17ahf") + htShowPage() + +s17ajf() == + page := htInitPage("S17AJF - Airy Function {\em Ai'(x)}", nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\windowlink{Manual Page}{manpageXXs17ajf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s17ajf| '|NagSpecialFunctionsPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\blankline ") + (text . "Evaluates {\em Ai'(x)}, ") + (text . "the derivative of the Airy function Ai(x) ") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the argument x: ") + (text . "\newline\tab{2} ") + (bcStrings (9 "-10.0" x 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", 'sGen) + htpSetProperty(page,'routine,"s17ajf") + htShowPage() + +s17akf() == + page := htInitPage("S17AKF - Airy Function {\em Bi'(x)}", nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\windowlink{Manual Page}{manpageXXs17akf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s17akf| '|NagSpecialFunctionsPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\blankline ") + (text . "Evaluates {\em Bi'(x)}, ") + (text . "the derivative of the Airy function Bi(x) ") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the argument x: ") + (text . "\newline\tab{2} ") + (bcStrings (9 "-10.0" x 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", 'sGen) + htpSetProperty(page,'routine,"s17akf") + htShowPage() + +s17dcf() == + htInitPage('"S17DCF - Bessel function \htbitmap{s17dcf}, real a \space{1} \htbitmap{great=} 0, complex z, v = 0,1,2,...",nil) + htMakePage '( + (domainConditions + (isDomain F (Float)) + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXs17dcf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s17dcf| '|NagSpecialFunctionsPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\newline ") + (text . "Returns a sequence of values for the Bessel functions ") + (text . "\htbitmap{s17dcf}, for complex z, non-negative v ") + (text . "and n = 0,1,...,N-1, with an option for exponential scaling.") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Order v of the first member of the sequence of functions ") + (text . "{\it FNU} \htbitmap{great=} 0:") + (text . "\newline \tab{2} ") + (bcStrings (10 "0.0" fnu F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Real part of {\it z}:") + (text . "\tab{32} \menuitemstyle{}\tab{34}") + (text . "Imaginary part of {\it z}:") + (text . "\newline \tab{2} ") + (bcStrings (10 "0.3" x F)) + (text . "\tab{34} ") + (bcStrings (10 "0.4" y F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Number of members required in sequence {\it N} ") + (text . "\htbitmap{great=} 1:") + (text . "\newline \tab{2} ") + (bcStrings (10 2 n PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Scaling option: ") + (radioButtons scale + ("" " Unscaled" u) + ("" " Scaled" s)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Ifail value: ") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 's17dcfGen) + htShowPage() + + +s17dcfGen htPage == + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + fnu := htpLabelInputString(htPage,'fnu) + x := htpLabelInputString(htPage,'x) + y := htpLabelInputString(htPage,'y) + uors := htpButtonValue(htPage,'scale) + scale := + uors = 'u => '"u" + '"s" + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => 1 + -1 + prefix := STRCONC('"s17dcf(",fnu,",complex(",x,",",y,"),",STRINGIMAGE n) + prefix := STRCONC(prefix,",_"",scale,"_", ",STRINGIMAGE ifail,")") + linkGen prefix + +s17def() == + htInitPage('"S17DEF - Bessel function \htbitmap{s17def}, real a \space{1} \htbitmap{great=} 0, complex z, v = 0,1,2,...",nil) + htMakePage '( + (domainConditions + (isDomain F (Float)) + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXs17def} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s17def| '|NagSpecialFunctionsPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\newline ") + (text . "Returns a sequence of values for the Bessel functions ") + (text . "\htbitmap{s17def}, for complex z, non-negative v ") + (text . "and n = 0,1,...,N-1, with an option for exponential scaling.") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Order v of the first member of the sequence of functions ") + (text . "{\it FNU} \htbitmap{great=} 0:") + (text . "\newline \tab{2} ") + (bcStrings (10 "0.0" fnu F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Real part of {\it z}:") + (text . "\tab{32} \menuitemstyle{}\tab{34}") + (text . "Imaginary part of {\it z}:") + (text . "\newline \tab{2} ") + (bcStrings (10 "0.3" x F)) + (text . "\tab{34} ") + (bcStrings (10 "0.4" y F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Number of members required in sequence {\it N} ") + (text . "\htbitmap{great=} 1:") + (text . "\newline \tab{2} ") + (bcStrings (10 2 n PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Scaling option: ") + (radioButtons scale + ("" " Unscaled" u) + ("" " Scaled" s)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Ifail value: ") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 's17defGen) + htShowPage() + + +s17defGen htPage == + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + fnu := htpLabelInputString(htPage,'fnu) + x := htpLabelInputString(htPage,'x) + y := htpLabelInputString(htPage,'y) + uors := htpButtonValue(htPage,'scale) + scale := + uors = 'u => '"u" + '"s" + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => 1 + -1 + prefix := STRCONC('"s17def(",fnu,",complex(",x,",",y,"),",STRINGIMAGE n) + prefix := STRCONC(prefix,",_"",scale,"_", ",STRINGIMAGE ifail,")") + linkGen prefix + + +s17dgf() == + htInitPage('"S17DGF - Airy functions {\em Ai(z)} and {\em Ai'(z)} ",nil) + htMakePage '( + (domainConditions + (isDomain F (Float)) + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXs17dgf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s17dgf| '|NagSpecialFunctionsPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\newline ") + (text . "Evaluates the Airy function Ai(z) or its derivative Ai'(z), ") + (text . "for complex z, with an option for exponential scaling. ") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Real part of {\it z}:") + (text . "\tab{32} \menuitemstyle{}\tab{34}") + (text . "Imaginary part of {\it z}:") + (text . "\newline \tab{2} ") + (bcStrings (10 "0.3" x F)) + (text . "\tab{34} ") + (bcStrings (10 "0.4" y F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Function or derivative required: ") + (radioButtons deriv + ("" " Function" f) + ("" " Derivative" d)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Scaling option: ") + (radioButtons scale + ("" " Unscaled" u) + ("" " Scaled" s)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Ifail value: ") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 's17dgfGen) + htShowPage() + + +s17dgfGen htPage == + x := htpLabelInputString(htPage,'x) + y := htpLabelInputString(htPage,'y) + ford := htpButtonValue(htPage,'deriv) + deriv := + ford = 'f => '"f" + '"d" + uors := htpButtonValue(htPage,'scale) + scale := + uors = 'u => '"u" + '"s" + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => 1 + -1 + prefix := STRCONC('"s17dgf(_"",deriv,"_",complex(",x,",",y,"),_"") + prefix := STRCONC(prefix,scale,"_", ",STRINGIMAGE ifail,")") + linkGen prefix + +s17dhf() == + htInitPage('"S17DHF - Airy functions {\em Bi(z)} and {\em Bi'(z)} ",nil) + htMakePage '( + (domainConditions + (isDomain F (Float)) + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXs17dhf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s17dhf| '|NagSpecialFunctionsPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\newline ") + (text . "Evaluates the Airy function Bi(z) or its derivative Bi'(z), ") + (text . "for complex z, with an option for exponential scaling. ") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Real part of {\it z}:") + (text . "\tab{32} \menuitemstyle{}\tab{34}") + (text . "Imaginary part of {\it z}:") + (text . "\newline \tab{2} ") + (bcStrings (10 "0.3" x F)) + (text . "\tab{34} ") + (bcStrings (10 "0.4" y F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Function or derivative required: ") + (radioButtons deriv + ("" " Function" f) + ("" " Derivative" d)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Scaling option: ") + (radioButtons scale + ("" " Unscaled" u) + ("" " Scaled" s)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Ifail value: ") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 's17dhfGen) + htShowPage() + + +s17dhfGen htPage == + x := htpLabelInputString(htPage,'x) + y := htpLabelInputString(htPage,'y) + ford := htpButtonValue(htPage,'deriv) + deriv := + ford = 'f => '"f" + '"d" + uors := htpButtonValue(htPage,'scale) + scale := + uors = 'u => '"u" + '"s" + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => 1 + -1 + prefix := STRCONC('"s17dhf(_"",deriv,"_",complex(",x,",",y,"),_"") + prefix := STRCONC(prefix,scale,"_", ",STRINGIMAGE ifail,")") + linkGen prefix + + +s17dlf() == + htInitPage('"S17DLF - Hankel function \vspace{-28} \htbitmap{s17dlf} \vspace{-37}, j = 1,2, real a \space{1} \htbitmap{great=} 0, complex z, v = 0,1,2,...",nil) + htMakePage '( + (domainConditions + (isDomain F (Float)) + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXs17dlf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s17dlf| '|NagSpecialFunctionsPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\newline ") + (text . "Returns a sequence of values for the Hankel functions ") + (text . "\htbitmap{s17dlf}, j = 1,2, for complex z, ") + (text . "non-negative v ") + (text . "and n = 0,1,...,N-1, with an option for exponential scaling.") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Order v of the first member of the sequence of functions ") + (text . "{\it FNU} \htbitmap{great=} 0:") + (text . "\newline \tab{2} ") + (bcStrings (10 "0.0" fnu F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Real part of {\it z}:") + (text . "\tab{32} \menuitemstyle{}\tab{34}") + (text . "Imaginary part of {\it z}:") + (text . "\newline \tab{2} ") + (bcStrings (10 "0.3" x F)) + (text . "\tab{34} ") + (bcStrings (10 "0.4" y F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Number of members required in sequence {\it N} ") + (text . "\htbitmap{great=} 1:") + (text . "\newline \tab{2} ") + (bcStrings (10 2 n PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Hankel function {\it m}: ") + (radioButtons hankel + ("" " \htbitmap{s17dlf1}" mone) + ("" " \htbitmap{s17dlf2}" mtwo)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Scaling option: ") + (radioButtons scale + ("" " Unscaled" u) + ("" " Scaled" s)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Ifail value: ") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 's17dlfGen) + htShowPage() + + +s17dlfGen htPage == + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + fnu := htpLabelInputString(htPage,'fnu) + x := htpLabelInputString(htPage,'x) + y := htpLabelInputString(htPage,'y) + hankel := htpButtonValue(htPage,'hankel) + m := + hankel = 'mone => '1 + '2 + uors := htpButtonValue(htPage,'scale) + scale := + uors = 'u => '"u" + '"s" + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => 1 + -1 + prefix := STRCONC('"s17dlf(",STRINGIMAGE m,", ",fnu,",complex(") + prefix := STRCONC(prefix,x,",",y,"),",STRINGIMAGE n) + prefix := STRCONC(prefix,",_"",scale,"_", ",STRINGIMAGE ifail,")") + linkGen prefix + + +s18acf() == + page := htInitPage("S18ACF - Modified Bessel Function \space{1} \vspace{-28} \inputbitmap{\htbmdir{}/s18acf1.bitmap}", nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\windowlink{Manual Page}{manpageXXs18acf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s18acf| '|NagSpecialFunctionsPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\blankline ") + (text . "Evaluates the modified Bessel function \space{1} \vspace{-28}") + (text . "\inputbitmap{\htbmdir{}/s18acf.bitmap} \vspace{-40}") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the argument x > 0.0: ") + (text . "\newline\tab{2} ") + (bcStrings (9 "0.4" x 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", 'sGen) + htpSetProperty(page,'routine,"s18acf") + htShowPage() + +s18adf() == + page := htInitPage("S18ADF - Modified Bessel Function \space{1} \vspace{-28} \inputbitmap{\htbmdir{}/s18adf1.bitmap}", nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\windowlink{Manual Page}{manpageXXs18adf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s18adf| '|NagSpecialFunctionsPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\blankline ") + (text . "Evaluates the modified Bessel function \space{1} \vspace{-28}") + (text . "\inputbitmap{\htbmdir{}/s18adf.bitmap} \vspace{-40}") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the argument x > 0.0: ") + (text . "\newline\tab{2} ") + (bcStrings (9 "0.4" x 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", 'sGen) + htpSetProperty(page,'routine,"s18adf") + htShowPage() + +s18aef() == + page := htInitPage("S18AeF - Modified Bessel Function \space{1} \vspace{-28} \inputbitmap{\htbmdir{}/s18aef1.bitmap}", nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\windowlink{Manual Page}{manpageXXs18aef} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s18aef| '|NagSpecialFunctionsPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\blankline ") + (text . "Evaluates the modified Bessel function \space{1} \vspace{-28}") + (text . "\inputbitmap{\htbmdir{}/s18aef.bitmap} \vspace{-40}") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the argument x: ") + (text . "\newline\tab{2} ") + (bcStrings (9 "0.5" x 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", 'sGen) + htpSetProperty(page,'routine,"s18aef") + htShowPage() + +s18aff() == + page := htInitPage("S18AFF - Modified Bessel Function \space{1} \vspace{-28} \inputbitmap{\htbmdir{}/s18aff1.bitmap}", nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\windowlink{Manual Page}{manpageXXs18aff} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s18aff| '|NagSpecialFunctionsPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\blankline ") + (text . "Evaluates the modified Bessel function \space{1} \vspace{-28}") + (text . "\inputbitmap{\htbmdir{}/s18aff.bitmap} \vspace{-40}") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the argument x: ") + (text . "\newline\tab{2} ") + (bcStrings (9 "0.5" x 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", 'sGen) + htpSetProperty(page,'routine,"s18aff") + htShowPage() + +s18dcf() == + htInitPage('"S18DCF - Bessel function \htbitmap{s18dcf}, real a \space{1} \htbitmap{great=} 0, complex z, v = 0,1,2,...",nil) + htMakePage '( + (domainConditions + (isDomain F (Float)) + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXs18dcf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s18dcf| '|NagSpecialFunctionsPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\newline ") + (text . "Returns a sequence of values for the modified Bessel functions ") + (text . "\htbitmap{s18dcf}, for complex z, non-negative v ") + (text . "and n = 0,1,...,N-1, with an option for exponential scaling.") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Order v of the first member of the sequence of functions ") + (text . "{\it FNU} \htbitmap{great=} 0:") + (text . "\newline \tab{2} ") + (bcStrings (10 "0.0" fnu F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Real part of {\it z}:") + (text . "\tab{32} \menuitemstyle{}\tab{34}") + (text . "Imaginary part of {\it z}:") + (text . "\newline \tab{2} ") + (bcStrings (10 "0.3" x F)) + (text . "\tab{34} ") + (bcStrings (10 "0.4" y F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Number of members required in sequence {\it N} ") + (text . "\htbitmap{great=} 1:") + (text . "\newline \tab{2} ") + (bcStrings (10 2 n PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Scaling option: ") + (radioButtons scale + ("" " Unscaled" u) + ("" " Scaled" s)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Ifail value: ") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 's18dcfGen) + htShowPage() + + +s18dcfGen htPage == + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + fnu := htpLabelInputString(htPage,'fnu) + x := htpLabelInputString(htPage,'x) + y := htpLabelInputString(htPage,'y) + uors := htpButtonValue(htPage,'scale) + scale := + uors = 'u => '"u" + '"s" + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => 1 + -1 + prefix := STRCONC('"s18dcf(",fnu,",complex(",x,",",y,"),",STRINGIMAGE n) + prefix := STRCONC(prefix,",_"",scale,"_", ",STRINGIMAGE ifail,")") + linkGen prefix + +s18def() == + htInitPage('"S18DEF - Modified bessel function \htbitmap{s18def}, real a \space{1} \htbitmap{great=} 0, complex z, v = 0,1,2,...",nil) + htMakePage '( + (domainConditions + (isDomain F (Float)) + (isDomain PI (PositiveInteger))) + (text . "\windowlink{Manual Page}{manpageXXs18def} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s18def| '|NagSpecialFunctionsPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\newline ") + (text . "Returns a sequence of values for the modified Bessel functions ") + (text . "\htbitmap{s18def}, for complex z, non-negative v ") + (text . "and n = 0,1,...,N-1, with an option for exponential scaling.") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Order v of the first member of the sequence of functions ") + (text . "{\it FNU} \htbitmap{great=} 0:") + (text . "\newline \tab{2} ") + (bcStrings (10 "0.0" fnu F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Real part of {\it z}:") + (text . "\tab{32} \menuitemstyle{}\tab{34}") + (text . "Imaginary part of {\it z}:") + (text . "\newline \tab{2} ") + (bcStrings (10 "0.3" x F)) + (text . "\tab{34} ") + (bcStrings (10 "-0.4" y F)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Number of members required in sequence {\it N} ") + (text . "\htbitmap{great=} 1:") + (text . "\newline \tab{2} ") + (bcStrings (10 2 n PI)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Scaling option: ") + (radioButtons scale + ("" " Unscaled" u) + ("" " Scaled" s)) + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{} \tab{2} ") + (text . "\newline \tab{2} ") + (text . "Ifail value: ") + (radioButtons ifail + ("" " -1, Print error messages" minusOne) + ("" " 1, Suppress error messages" one))) + htMakeDoneButton('"Continue", 's18defGen) + htShowPage() + + +s18defGen htPage == + n := + $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) + objValUnwrap htpLabelSpadValue(htPage, 'n) + fnu := htpLabelInputString(htPage,'fnu) + x := htpLabelInputString(htPage,'x) + y := htpLabelInputString(htPage,'y) + uors := htpButtonValue(htPage,'scale) + scale := + uors = 'u => '"u" + '"s" + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => 1 + -1 + prefix := STRCONC('"s18def(",fnu,",complex(",x,",",y,"),",STRINGIMAGE n) + prefix := STRCONC(prefix,",_"",scale,"_", ",STRINGIMAGE ifail,")") + linkGen prefix + + +s19aaf() == + page := htInitPage("S19AAF - Kelvin Function {\em ber x}", nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\windowlink{Manual Page}{manpageXXs19aaf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s19aaf| '|NagSpecialFunctionsPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\blankline ") + (text . "Evaluates the Kelvin function {\em ber x}") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the argument x: ") + (text . "\newline\tab{2} ") + (bcStrings (9 "1.0" x 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", 'sGen) + htpSetProperty(page,'routine,"s19aaf") + htShowPage() + +s19abf() == + page := htInitPage("S19ABF - Kelvin Function {\em bei x}", nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\windowlink{Manual Page}{manpageXXs19abf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s19abf| '|NagSpecialFunctionsPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\blankline ") + (text . "Evaluates the Kelvin function {\em bei x}") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the argument x: ") + (text . "\newline\tab{2} ") + (bcStrings (9 "0.1" x 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", 'sGen) + htpSetProperty(page,'routine,"s19abf") + htShowPage() + +s19acf() == + page := htInitPage("S19ACF - Kelvin Function {\em ker x}", nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\windowlink{Manual Page}{manpageXXs19acf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s19acf| '|NagSpecialFunctionsPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\blankline ") + (text . "Evaluates the Kelvin function {\em ker x}") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the argument x > 0.0: ") + (text . "\newline\tab{2} ") + (bcStrings (9 "0.1" x 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", 'sGen) + htpSetProperty(page,'routine,"s19acf") + htShowPage() + +s19adf() == + page := htInitPage("S19AAF - Kelvin Function {\em kei x}", nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\windowlink{Manual Page}{manpageXXs19adf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s19adf| '|NagSpecialFunctionsPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\blankline ") + (text . "Evaluates the Kelvin function {\em kei x}") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the argument x \inputbitmap{\htbmdir{}/great=.bitmap} 0.0: ") + (text . "\newline\tab{2} ") + (bcStrings (9 "0.0" x 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", 'sGen) + htpSetProperty(page,'routine,"s19adf") + htShowPage() + +s20acf() == + page := htInitPage("S20ACF - Fresnel Integral {\em S(x)}",nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\windowlink{Manual Page}{manpageXXs20acf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s20acf| '|NagSpecialFunctionsPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\blankline ") + (text . "Evaluates the Fresnel Integral {\em S(x)}") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the argument x: ") + (text . "\newline\tab{2} ") + (bcStrings (9 "0.5" x 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", 'sGen) + htpSetProperty(page,'routine,"s20acf") + htShowPage() + +s20adf() == + page := htInitPage("S20ADF - Fresnel Integral {\em C(x)}",nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\windowlink{Manual Page}{manpageXXs20adf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s20adf| '|NagSpecialFunctionsPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\blankline ") + (text . "Evaluates the Fresnel Integral {\em C(x)}") + (text . "\blankline ") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the argument x: ") + (text . "\newline\tab{2} ") + (bcStrings (9 "0.5" x 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", 'sGen) + htpSetProperty(page,'routine,"s20adf") + htShowPage() + +s21baf() == + htInitPage("S21BAF - Degenerate Symmetrised Elliptic Integral of 1st Kind \vspace{-28} \inputbitmap{\htbmdir{}/s21baf1.bitmap}", nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\windowlink{Manual Page}{manpageXXs21baf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s21baf| '|NagSpecialFunctionsPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\blankline ") + (text . "Evaluates the elementary (degenerate symmetrised elliptic) ") + (text . " integral \space{1} \vspace{-28} \inputbitmap{\htbmdir{}/s21baf.bitmap} ") + (text . "\blankline ") + (text . "\newline ") + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} ") + (text . "Enter the argument x \space{1}\inputbitmap{\htbmdir{}/great=.bitmap} 0.0: ") + (text . "\tab{32} \menuitemstyle{}\tab{34} ") + (text . "Enter the argument y \notequal 0.0: ") + (text . "\newline\tab{2} ") + (bcStrings (10 "0.5" x F)) + (text . "\tab{34} ") + (bcStrings (10 "1.0" y 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", 's21bafGen) + htShowPage() + +s21bafGen htPage == + x := htpLabelInputString(htPage,'x) + y := htpLabelInputString(htPage,'y) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => 1 + -1 + linkGen STRCONC("s21baf(",x,'",",y,",",STRINGIMAGE ifail,'")") + +s21bbf() == + htInitPage("S21BBF - Symmetrised Elliptic Integral of 1st Kind \space{1} \vspace{-28} \inputbitmap{\htbmdir{}/s21bbf1.bitmap}", nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\windowlink{Manual Page}{manpageXXs21bbf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s21bbf| '|NagSpecialFunctionsPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\blankline ") + (text . "Evaluates the symmetrised elliptic integral of the first kind ") + (text . "\space{1} \vspace{-28} \inputbitmap{\htbmdir{}/s21bbf.bitmap} ") + (text . "\newline ") + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} ") + (text . "Enter the argument x \space{1}\inputbitmap{\htbmdir{}/great=.bitmap} 0.0: ") + (text . "\tab{32} \menuitemstyle{}\tab{34} ") + (text . "Enter the argument y \space{1}\inputbitmap{\htbmdir{}/great=.bitmap} 0.0: ") + (text . "\newline\tab{2} ") + (bcStrings (10 "0.5" x F)) + (text . "\tab{34} ") + (bcStrings (10 "1.0" y F)) + (text . "\blankline") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the argument z \space{1}\inputbitmap{\htbmdir{}/great=.bitmap} 0.0; ") + (text . "at most one of x,y and z may be equal to 0.0: \newline \tab{2}") + (bcStrings (10 "1.5" z 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", 's21bbfGen) + htShowPage() + +s21bbfGen htPage == + x := htpLabelInputString(htPage,'x) + y := htpLabelInputString(htPage,'y) + z := htpLabelInputString(htPage,'z) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => 1 + -1 + linkGen STRCONC("s21bbf(",x,'",",y,",",z,",",STRINGIMAGE ifail,'")") + +s21bcf() == + htInitPage("S21BCF - Symmetrised Elliptic Integral of 2nd Kind \space{1} \vspace{-28} \inputbitmap{\htbmdir{}/s21bcf1.bitmap}", nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\windowlink{Manual Page}{manpageXXs21bcf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s21bcf| '|NagSpecialFunctionsPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\blankline ") + (text . "Evaluates the symmetrised elliptic integral of the second kind ") + (text . "\space{1} \vspace{-28} \inputbitmap{\htbmdir{}/s21bcf.bitmap} ") + (text . "\newline ") + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} ") + (text . "Enter the argument x \space{1}\inputbitmap{\htbmdir{}/great=.bitmap} 0.0: ") + (text . "\tab{32} \menuitemstyle{}\tab{34} ") + (text . "Enter the argument y \space{1}\inputbitmap{\htbmdir{}/great=.bitmap} 0.0: ") + (text . "\newline\tab{2} ") + (bcStrings (10 "0.5" x F)) + (text . "\tab{34} ") + (bcStrings (10 "0.5" y F)) + (text . "\blankline") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the argument z > 0.0; ") + (text . "at most one of x, y and z may be equal to 0.0: \newline \tab{2}") + (bcStrings (10 "1.0" z 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", 's21bcfGen) + htShowPage() + +s21bcfGen htPage == + x := htpLabelInputString(htPage,'x) + y := htpLabelInputString(htPage,'y) + z := htpLabelInputString(htPage,'z) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => 1 + -1 + linkGen STRCONC("s21bcf(",x,'",",y,",",z,",",STRINGIMAGE ifail,'")") + +s21bdf() == + htInitPage("S21BDF - Symmetrised Elliptic Integral of 3rd Kind \space{1} \vspace{-28} \inputbitmap{\htbmdir{}/s21bdf1.bitmap}", nil) + htMakePage '( + (domainConditions + (isDomain F (Float))) + (text . "\windowlink{Manual Page}{manpageXXs21bdf} for this routine ") + (text . "\newline ") + (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s21bdf| '|NagSpecialFunctionsPackage|)} for this routine") + (text . "\newline \horizontalline ") + (text . "\blankline ") + (text . "Evaluates the symmetrised elliptic integral of the third kind ") + (text . "\space{1} \vspace{-28} \inputbitmap{\htbmdir{}/s21bdf.bitmap} ") + (text . "\newline ") + (text . "\blankline ") + (text . "\newline \menuitemstyle{}\tab{2} ") + (text . "Enter the argument x \space{1}\inputbitmap{\htbmdir{}/great=.bitmap} 0.0: ") + (text . "\tab{32} \menuitemstyle{}\tab{34} ") + (text . "Enter the argument y \space{1}\inputbitmap{\htbmdir{}/great=.bitmap} 0.0: ") + (text . "\newline\tab{2} ") + (bcStrings (10 "0.5" x F)) + (text . "\tab{34} ") + (bcStrings (10 "0.5" y F)) + (text . "\blankline") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the argument z \space{1}\inputbitmap{\htbmdir{}/great=.bitmap} 0.0; ") + (text . "at most one of x, y and z may be equal to 0.0: \newline \tab{2}") + (bcStrings (10 "0.5" z F)) + (text . "\blankline") + (text . "\newline ") + (text . "\menuitemstyle{}\tab{2}") + (text . "Enter the argument \rho \notequal 0.0: \newline \tab{2} ") + (bcStrings (10 "2.0" r 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", 's21bdfGen) + htShowPage() + +s21bdfGen htPage == + x := htpLabelInputString(htPage,'x) + y := htpLabelInputString(htPage,'y) + z := htpLabelInputString(htPage,'z) + r := htpLabelInputString(htPage,'r) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => 1 + -1 + linkGen STRCONC("s21bdf(",x,'",",y,",",z,",",r,",",STRINGIMAGE ifail,'")") + +sGen htPage == + routine := htpProperty(htPage,'routine) + x := htpLabelInputString(htPage,'x) + error := htpButtonValue(htPage,'ifail) + ifail := + error = 'one => 1 + -1 + linkGen STRCONC(routine,"(",x,'",",STRINGIMAGE ifail,'")") + diff --git a/src/interp/nag-s.boot.pamphlet b/src/interp/nag-s.boot.pamphlet deleted file mode 100644 index 99c54d7f..00000000 --- a/src/interp/nag-s.boot.pamphlet +++ /dev/null @@ -1,1606 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp nag-s.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. - -@ -<<*>>= -<> - -)package "BOOT" - -s01eaf() == - page := htInitPage("S01EAF - Complex exponential {\em exp(z)} ",nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXs01eaf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s01eaf| '|NagSpecialFunctionsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "Evaluates the exponential function, exp(z), for complex z. ") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Real part of {\it z}:") - (text . "\tab{32} \menuitemstyle{}\tab{34}") - (text . "Imaginary part of {\it z}:") - (text . "\newline \tab{2} ") - (bcStrings (10 "-0.5" x F)) - (text . "\tab{34} ") - (bcStrings (10 "2.0" y 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", 's01eafGen) - htShowPage() - -s01eafGen htPage == - x := htpLabelInputString(htPage,'x) - y := htpLabelInputString(htPage,'y) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => 1 - -1 - linkGen STRCONC('"s01eaf(complex(",x,",",y,"),",STRINGIMAGE ifail,")") - - - -s13aaf() == - page := htInitPage("S13AAF - Exponential integral \htbitmap{s13aaf2}", nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXs13aaf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s13aaf| '|NagSpecialFunctionsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\blankline ") - (text . "Evaluates the exponential integral \vspace{-32} ") - (text . "\htbitmap{s13aaf1} ") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the argument x > 0.0: ") - (text . "\newline\tab{2} ") - (bcStrings (9 "2.0" x 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", 'sGen) - htpSetProperty(page,'routine,"s13aaf") - htShowPage() - -s13acf() == - page := htInitPage("S13ACF - Cosine integral {\em Ci(x)} ",nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXs13acf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s13acf| '|NagSpecialFunctionsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\blankline ") - (text . "Evaluates the cosine integral \space{1} ") - (text . "\htbitmap{s13acf} ") - (text . ", where \gamma denotes Euler's constant. ") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the argument x > 0.0: ") - (text . "\newline\tab{2} ") - (bcStrings (9 "0.2" x 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", 'sGen) - htpSetProperty(page,'routine,"s13acf") - htShowPage() - -s13adf() == - page := htInitPage("S13ADF - Sine integral Si(x) ",nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXs13adf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s13adf| '|NagSpecialFunctionsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\blankline ") - (text . "Evaluates the sine integral \space{1} \vspace{-32} ") - (text . "\inputbitmap{\htbmdir{}/s13adf.bitmap} \vspace{-37}. ") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the argument x: ") - (text . "\newline\tab{2} ") - (bcStrings (9 "0.2" x 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", 'sGen) - htpSetProperty(page,'routine,"s13adf") - htShowPage() - -s14aaf() == - page := htInitPage("S14AAF - Gamma Function \Gamma(x) ",nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXs14aaf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s14aaf| '|NagSpecialFunctionsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\blankline ") - (text . "Evaluates the gamma function, {\em Gamma(x)}. ") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the argument x > 0.0: ") - (text . "\newline\tab{2} ") - (bcStrings (9 "1.25" x 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", 'sGen) - htpSetProperty(page,'routine,"s14aaf") - htShowPage() - -s14abf() == - page := htInitPage("S14ABF - Log Gamma Function \Gamma(x) ",nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXs14abf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s14abf| '|NagSpecialFunctionsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\blankline ") - (text . "Evaluates the logarithm of the gamma function, ") - (text . "{\em ln Gamma(x)}. ") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the argument x > 0.0: ") - (text . "\newline\tab{2} ") - (bcStrings (9 "1.25" x 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", 'sGen) - htpSetProperty(page,'routine,"s14abf") - htShowPage() - -s14baf() == - htInitPage("S14BAF - Incomplete Gamma Functions P(a,x) & Q(a,x)",nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXs14baf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s14baf| '|NagSpecialFunctionsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\blankline ") - (text . "Evaluates the incomplete gamma functions, \space{1} ") - (text . "\vspace{-32} \inputbitmap{\htbmdir{}/s14baf.bitmap} \vspace{-37}, ") - (text . "which are normalised such that P(a,x) + Q(a,x) = 1. ") - (text . "\blankline ") - (text . "\newline ") - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") - (text . "Enter the value of {\em a}: > 0.0") - (text . "\tab{32} \menuitemstyle{}\tab{34} ") - (text . "Enter the value of {\em x}: >= 0.0 ") - (text . "\newline\tab{2} ") - (bcStrings (10 "2.0" a F)) - (text . "\tab{34} ") - (bcStrings (10 "3.0" x F)) - (text . "\blankline") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the tolerance:") - (text . "\newline\tab{2} ") - (bcStrings (30 "1.1102230246251600E-16" tol 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", 's14bafGen) - htShowPage() - -s14bafGen htPage == - a := htpLabelInputString(htPage,'a) - x := htpLabelInputString(htPage,'x) - tol := htpLabelInputString(htPage,'tol) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => 1 - -1 - linkGen STRCONC('"s14baf(",a,",",x,",",tol,",",STRINGIMAGE ifail,")") - -s15adf() == - page := htInitPage("S15ADF - Complement of error function erfc x",nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXs15adf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s15adf| '|NagSpecialFunctionsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\blankline ") - (text . "Evaluates the complementary gamma functions, erfc x = ") - (text . "\space{1} \vspace{-32} \inputbitmap{\htbmdir{}/s15adf.bitmap} ") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the argument x: ") - (text . "\newline\tab{2} ") - (bcStrings (9 "-10.0" x 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", 'sGen) - htpSetProperty(page,'routine,"s15adf") - htShowPage() - -s15aef() == - page := htInitPage("S15AEF - Error Function erf x", nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXs15aef} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s15aef| '|NagSpecialFunctionsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\blankline ") - (text . "Evaluates the error function, erf x = \space{1} ") - (text . "\vspace{-32} \inputbitmap{\htbmdir{}/s15aef.bitmap} ") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the argument x: ") - (text . "\newline\tab{2} ") - (bcStrings (9 "-6.0" x 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", 'sGen) - htpSetProperty(page,'routine,"s15aef") - htShowPage() - -s17acf() == - page := htInitPage("S17ACF - Bessel Function \space{1} \htbitmap{s17acf}", nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXs17acf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s17acf| '|NagSpecialFunctionsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\blankline ") - (text . "Evaluates the Bessel function \space{1} \htbitmap{s17acf}") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the argument x > 0.0: ") - (text . "\newline\tab{2} ") - (bcStrings (9 "0.5" x 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", 'sGen) - htpSetProperty(page,'routine,"s17acf") - htShowPage() - -s17adf() == - page := htInitPage("S17ADF - Bessel Function \space{1} \htbitmap{s17adf}", nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXs17adf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s17adf| '|NagSpecialFunctionsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\blankline ") - (text . "Evaluates the Bessel function \space{1} \htbitmap{s17adf}") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the argument x > 0.0: ") - (text . "\newline\tab{2} ") - (bcStrings (9 "0.5" x 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", 'sGen) - htpSetProperty(page,'routine,"s17adf") - htShowPage() - -s17aef() == - page := htInitPage("S17AEF - Bessel Function \space{1} \htbitmap{s17aef}", nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXs17aef} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s17aef| '|NagSpecialFunctionsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\blankline ") - (text . "Evaluates the Bessel function \space{1}") - (text . "\htbitmap{s17aef}") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the argument x > 0.0: ") - (text . "\newline\tab{2} ") - (bcStrings (9 "0.5" x 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", 'sGen) - htpSetProperty(page,'routine,"s17aef") - htShowPage() - -s17aff() == - page := htInitPage("S17AFF - Bessel Function \space{1} \htbitmap{s17aff}", nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXs17aff} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s17aff| '|NagSpecialFunctionsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\blankline ") - (text . "Evaluates the Bessel function \space{1} \htbitmap{s17aff}") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the argument x: ") - (text . "\newline\tab{2} ") - (bcStrings (9 "0.5" x 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", 'sGen) - htpSetProperty(page,'routine,"s17aff") - htShowPage() - -s17agf() == - page := htInitPage("S17AGF - Airy Function {\em Ai(x)}", nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXs17agf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s17agf| '|NagSpecialFunctionsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\blankline ") - (text . "Evaluates the Airy function {\em Ai(x)} ") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the argument x: ") - (text . "\newline\tab{2} ") - (bcStrings (9 "-10.0" x 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", 'sGen) - htpSetProperty(page,'routine,"s17agf") - htShowPage() - -s17ahf() == - page := htInitPage("S17AHF - Airy Function {\em Bi(x)}", nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXs17ahf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s17ahf| '|NagSpecialFunctionsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\blankline ") - (text . "Evaluates the Airy function {\em Bi(x)} ") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the argument x: ") - (text . "\newline\tab{2} ") - (bcStrings (9 "-10.0" x 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", 'sGen) - htpSetProperty(page,'routine,"s17ahf") - htShowPage() - -s17ajf() == - page := htInitPage("S17AJF - Airy Function {\em Ai'(x)}", nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXs17ajf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s17ajf| '|NagSpecialFunctionsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\blankline ") - (text . "Evaluates {\em Ai'(x)}, ") - (text . "the derivative of the Airy function Ai(x) ") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the argument x: ") - (text . "\newline\tab{2} ") - (bcStrings (9 "-10.0" x 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", 'sGen) - htpSetProperty(page,'routine,"s17ajf") - htShowPage() - -s17akf() == - page := htInitPage("S17AKF - Airy Function {\em Bi'(x)}", nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXs17akf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s17akf| '|NagSpecialFunctionsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\blankline ") - (text . "Evaluates {\em Bi'(x)}, ") - (text . "the derivative of the Airy function Bi(x) ") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the argument x: ") - (text . "\newline\tab{2} ") - (bcStrings (9 "-10.0" x 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", 'sGen) - htpSetProperty(page,'routine,"s17akf") - htShowPage() - -s17dcf() == - htInitPage('"S17DCF - Bessel function \htbitmap{s17dcf}, real a \space{1} \htbitmap{great=} 0, complex z, v = 0,1,2,...",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXs17dcf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s17dcf| '|NagSpecialFunctionsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "Returns a sequence of values for the Bessel functions ") - (text . "\htbitmap{s17dcf}, for complex z, non-negative v ") - (text . "and n = 0,1,...,N-1, with an option for exponential scaling.") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Order v of the first member of the sequence of functions ") - (text . "{\it FNU} \htbitmap{great=} 0:") - (text . "\newline \tab{2} ") - (bcStrings (10 "0.0" fnu F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Real part of {\it z}:") - (text . "\tab{32} \menuitemstyle{}\tab{34}") - (text . "Imaginary part of {\it z}:") - (text . "\newline \tab{2} ") - (bcStrings (10 "0.3" x F)) - (text . "\tab{34} ") - (bcStrings (10 "0.4" y F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Number of members required in sequence {\it N} ") - (text . "\htbitmap{great=} 1:") - (text . "\newline \tab{2} ") - (bcStrings (10 2 n PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Scaling option: ") - (radioButtons scale - ("" " Unscaled" u) - ("" " Scaled" s)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 's17dcfGen) - htShowPage() - - -s17dcfGen htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - fnu := htpLabelInputString(htPage,'fnu) - x := htpLabelInputString(htPage,'x) - y := htpLabelInputString(htPage,'y) - uors := htpButtonValue(htPage,'scale) - scale := - uors = 'u => '"u" - '"s" - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => 1 - -1 - prefix := STRCONC('"s17dcf(",fnu,",complex(",x,",",y,"),",STRINGIMAGE n) - prefix := STRCONC(prefix,",_"",scale,"_", ",STRINGIMAGE ifail,")") - linkGen prefix - -s17def() == - htInitPage('"S17DEF - Bessel function \htbitmap{s17def}, real a \space{1} \htbitmap{great=} 0, complex z, v = 0,1,2,...",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXs17def} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s17def| '|NagSpecialFunctionsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "Returns a sequence of values for the Bessel functions ") - (text . "\htbitmap{s17def}, for complex z, non-negative v ") - (text . "and n = 0,1,...,N-1, with an option for exponential scaling.") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Order v of the first member of the sequence of functions ") - (text . "{\it FNU} \htbitmap{great=} 0:") - (text . "\newline \tab{2} ") - (bcStrings (10 "0.0" fnu F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Real part of {\it z}:") - (text . "\tab{32} \menuitemstyle{}\tab{34}") - (text . "Imaginary part of {\it z}:") - (text . "\newline \tab{2} ") - (bcStrings (10 "0.3" x F)) - (text . "\tab{34} ") - (bcStrings (10 "0.4" y F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Number of members required in sequence {\it N} ") - (text . "\htbitmap{great=} 1:") - (text . "\newline \tab{2} ") - (bcStrings (10 2 n PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Scaling option: ") - (radioButtons scale - ("" " Unscaled" u) - ("" " Scaled" s)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 's17defGen) - htShowPage() - - -s17defGen htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - fnu := htpLabelInputString(htPage,'fnu) - x := htpLabelInputString(htPage,'x) - y := htpLabelInputString(htPage,'y) - uors := htpButtonValue(htPage,'scale) - scale := - uors = 'u => '"u" - '"s" - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => 1 - -1 - prefix := STRCONC('"s17def(",fnu,",complex(",x,",",y,"),",STRINGIMAGE n) - prefix := STRCONC(prefix,",_"",scale,"_", ",STRINGIMAGE ifail,")") - linkGen prefix - - -s17dgf() == - htInitPage('"S17DGF - Airy functions {\em Ai(z)} and {\em Ai'(z)} ",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXs17dgf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s17dgf| '|NagSpecialFunctionsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "Evaluates the Airy function Ai(z) or its derivative Ai'(z), ") - (text . "for complex z, with an option for exponential scaling. ") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Real part of {\it z}:") - (text . "\tab{32} \menuitemstyle{}\tab{34}") - (text . "Imaginary part of {\it z}:") - (text . "\newline \tab{2} ") - (bcStrings (10 "0.3" x F)) - (text . "\tab{34} ") - (bcStrings (10 "0.4" y F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Function or derivative required: ") - (radioButtons deriv - ("" " Function" f) - ("" " Derivative" d)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Scaling option: ") - (radioButtons scale - ("" " Unscaled" u) - ("" " Scaled" s)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 's17dgfGen) - htShowPage() - - -s17dgfGen htPage == - x := htpLabelInputString(htPage,'x) - y := htpLabelInputString(htPage,'y) - ford := htpButtonValue(htPage,'deriv) - deriv := - ford = 'f => '"f" - '"d" - uors := htpButtonValue(htPage,'scale) - scale := - uors = 'u => '"u" - '"s" - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => 1 - -1 - prefix := STRCONC('"s17dgf(_"",deriv,"_",complex(",x,",",y,"),_"") - prefix := STRCONC(prefix,scale,"_", ",STRINGIMAGE ifail,")") - linkGen prefix - -s17dhf() == - htInitPage('"S17DHF - Airy functions {\em Bi(z)} and {\em Bi'(z)} ",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXs17dhf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s17dhf| '|NagSpecialFunctionsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "Evaluates the Airy function Bi(z) or its derivative Bi'(z), ") - (text . "for complex z, with an option for exponential scaling. ") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Real part of {\it z}:") - (text . "\tab{32} \menuitemstyle{}\tab{34}") - (text . "Imaginary part of {\it z}:") - (text . "\newline \tab{2} ") - (bcStrings (10 "0.3" x F)) - (text . "\tab{34} ") - (bcStrings (10 "0.4" y F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Function or derivative required: ") - (radioButtons deriv - ("" " Function" f) - ("" " Derivative" d)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Scaling option: ") - (radioButtons scale - ("" " Unscaled" u) - ("" " Scaled" s)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 's17dhfGen) - htShowPage() - - -s17dhfGen htPage == - x := htpLabelInputString(htPage,'x) - y := htpLabelInputString(htPage,'y) - ford := htpButtonValue(htPage,'deriv) - deriv := - ford = 'f => '"f" - '"d" - uors := htpButtonValue(htPage,'scale) - scale := - uors = 'u => '"u" - '"s" - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => 1 - -1 - prefix := STRCONC('"s17dhf(_"",deriv,"_",complex(",x,",",y,"),_"") - prefix := STRCONC(prefix,scale,"_", ",STRINGIMAGE ifail,")") - linkGen prefix - - -s17dlf() == - htInitPage('"S17DLF - Hankel function \vspace{-28} \htbitmap{s17dlf} \vspace{-37}, j = 1,2, real a \space{1} \htbitmap{great=} 0, complex z, v = 0,1,2,...",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXs17dlf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s17dlf| '|NagSpecialFunctionsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "Returns a sequence of values for the Hankel functions ") - (text . "\htbitmap{s17dlf}, j = 1,2, for complex z, ") - (text . "non-negative v ") - (text . "and n = 0,1,...,N-1, with an option for exponential scaling.") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Order v of the first member of the sequence of functions ") - (text . "{\it FNU} \htbitmap{great=} 0:") - (text . "\newline \tab{2} ") - (bcStrings (10 "0.0" fnu F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Real part of {\it z}:") - (text . "\tab{32} \menuitemstyle{}\tab{34}") - (text . "Imaginary part of {\it z}:") - (text . "\newline \tab{2} ") - (bcStrings (10 "0.3" x F)) - (text . "\tab{34} ") - (bcStrings (10 "0.4" y F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Number of members required in sequence {\it N} ") - (text . "\htbitmap{great=} 1:") - (text . "\newline \tab{2} ") - (bcStrings (10 2 n PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Hankel function {\it m}: ") - (radioButtons hankel - ("" " \htbitmap{s17dlf1}" mone) - ("" " \htbitmap{s17dlf2}" mtwo)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Scaling option: ") - (radioButtons scale - ("" " Unscaled" u) - ("" " Scaled" s)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 's17dlfGen) - htShowPage() - - -s17dlfGen htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - fnu := htpLabelInputString(htPage,'fnu) - x := htpLabelInputString(htPage,'x) - y := htpLabelInputString(htPage,'y) - hankel := htpButtonValue(htPage,'hankel) - m := - hankel = 'mone => '1 - '2 - uors := htpButtonValue(htPage,'scale) - scale := - uors = 'u => '"u" - '"s" - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => 1 - -1 - prefix := STRCONC('"s17dlf(",STRINGIMAGE m,", ",fnu,",complex(") - prefix := STRCONC(prefix,x,",",y,"),",STRINGIMAGE n) - prefix := STRCONC(prefix,",_"",scale,"_", ",STRINGIMAGE ifail,")") - linkGen prefix - - -s18acf() == - page := htInitPage("S18ACF - Modified Bessel Function \space{1} \vspace{-28} \inputbitmap{\htbmdir{}/s18acf1.bitmap}", nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXs18acf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s18acf| '|NagSpecialFunctionsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\blankline ") - (text . "Evaluates the modified Bessel function \space{1} \vspace{-28}") - (text . "\inputbitmap{\htbmdir{}/s18acf.bitmap} \vspace{-40}") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the argument x > 0.0: ") - (text . "\newline\tab{2} ") - (bcStrings (9 "0.4" x 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", 'sGen) - htpSetProperty(page,'routine,"s18acf") - htShowPage() - -s18adf() == - page := htInitPage("S18ADF - Modified Bessel Function \space{1} \vspace{-28} \inputbitmap{\htbmdir{}/s18adf1.bitmap}", nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXs18adf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s18adf| '|NagSpecialFunctionsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\blankline ") - (text . "Evaluates the modified Bessel function \space{1} \vspace{-28}") - (text . "\inputbitmap{\htbmdir{}/s18adf.bitmap} \vspace{-40}") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the argument x > 0.0: ") - (text . "\newline\tab{2} ") - (bcStrings (9 "0.4" x 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", 'sGen) - htpSetProperty(page,'routine,"s18adf") - htShowPage() - -s18aef() == - page := htInitPage("S18AeF - Modified Bessel Function \space{1} \vspace{-28} \inputbitmap{\htbmdir{}/s18aef1.bitmap}", nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXs18aef} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s18aef| '|NagSpecialFunctionsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\blankline ") - (text . "Evaluates the modified Bessel function \space{1} \vspace{-28}") - (text . "\inputbitmap{\htbmdir{}/s18aef.bitmap} \vspace{-40}") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the argument x: ") - (text . "\newline\tab{2} ") - (bcStrings (9 "0.5" x 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", 'sGen) - htpSetProperty(page,'routine,"s18aef") - htShowPage() - -s18aff() == - page := htInitPage("S18AFF - Modified Bessel Function \space{1} \vspace{-28} \inputbitmap{\htbmdir{}/s18aff1.bitmap}", nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXs18aff} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s18aff| '|NagSpecialFunctionsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\blankline ") - (text . "Evaluates the modified Bessel function \space{1} \vspace{-28}") - (text . "\inputbitmap{\htbmdir{}/s18aff.bitmap} \vspace{-40}") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the argument x: ") - (text . "\newline\tab{2} ") - (bcStrings (9 "0.5" x 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", 'sGen) - htpSetProperty(page,'routine,"s18aff") - htShowPage() - -s18dcf() == - htInitPage('"S18DCF - Bessel function \htbitmap{s18dcf}, real a \space{1} \htbitmap{great=} 0, complex z, v = 0,1,2,...",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXs18dcf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s18dcf| '|NagSpecialFunctionsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "Returns a sequence of values for the modified Bessel functions ") - (text . "\htbitmap{s18dcf}, for complex z, non-negative v ") - (text . "and n = 0,1,...,N-1, with an option for exponential scaling.") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Order v of the first member of the sequence of functions ") - (text . "{\it FNU} \htbitmap{great=} 0:") - (text . "\newline \tab{2} ") - (bcStrings (10 "0.0" fnu F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Real part of {\it z}:") - (text . "\tab{32} \menuitemstyle{}\tab{34}") - (text . "Imaginary part of {\it z}:") - (text . "\newline \tab{2} ") - (bcStrings (10 "0.3" x F)) - (text . "\tab{34} ") - (bcStrings (10 "0.4" y F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Number of members required in sequence {\it N} ") - (text . "\htbitmap{great=} 1:") - (text . "\newline \tab{2} ") - (bcStrings (10 2 n PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Scaling option: ") - (radioButtons scale - ("" " Unscaled" u) - ("" " Scaled" s)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 's18dcfGen) - htShowPage() - - -s18dcfGen htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - fnu := htpLabelInputString(htPage,'fnu) - x := htpLabelInputString(htPage,'x) - y := htpLabelInputString(htPage,'y) - uors := htpButtonValue(htPage,'scale) - scale := - uors = 'u => '"u" - '"s" - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => 1 - -1 - prefix := STRCONC('"s18dcf(",fnu,",complex(",x,",",y,"),",STRINGIMAGE n) - prefix := STRCONC(prefix,",_"",scale,"_", ",STRINGIMAGE ifail,")") - linkGen prefix - -s18def() == - htInitPage('"S18DEF - Modified bessel function \htbitmap{s18def}, real a \space{1} \htbitmap{great=} 0, complex z, v = 0,1,2,...",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXs18def} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s18def| '|NagSpecialFunctionsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "Returns a sequence of values for the modified Bessel functions ") - (text . "\htbitmap{s18def}, for complex z, non-negative v ") - (text . "and n = 0,1,...,N-1, with an option for exponential scaling.") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Order v of the first member of the sequence of functions ") - (text . "{\it FNU} \htbitmap{great=} 0:") - (text . "\newline \tab{2} ") - (bcStrings (10 "0.0" fnu F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Real part of {\it z}:") - (text . "\tab{32} \menuitemstyle{}\tab{34}") - (text . "Imaginary part of {\it z}:") - (text . "\newline \tab{2} ") - (bcStrings (10 "0.3" x F)) - (text . "\tab{34} ") - (bcStrings (10 "-0.4" y F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Number of members required in sequence {\it N} ") - (text . "\htbitmap{great=} 1:") - (text . "\newline \tab{2} ") - (bcStrings (10 2 n PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Scaling option: ") - (radioButtons scale - ("" " Unscaled" u) - ("" " Scaled" s)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 's18defGen) - htShowPage() - - -s18defGen htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - fnu := htpLabelInputString(htPage,'fnu) - x := htpLabelInputString(htPage,'x) - y := htpLabelInputString(htPage,'y) - uors := htpButtonValue(htPage,'scale) - scale := - uors = 'u => '"u" - '"s" - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => 1 - -1 - prefix := STRCONC('"s18def(",fnu,",complex(",x,",",y,"),",STRINGIMAGE n) - prefix := STRCONC(prefix,",_"",scale,"_", ",STRINGIMAGE ifail,")") - linkGen prefix - - -s19aaf() == - page := htInitPage("S19AAF - Kelvin Function {\em ber x}", nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXs19aaf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s19aaf| '|NagSpecialFunctionsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\blankline ") - (text . "Evaluates the Kelvin function {\em ber x}") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the argument x: ") - (text . "\newline\tab{2} ") - (bcStrings (9 "1.0" x 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", 'sGen) - htpSetProperty(page,'routine,"s19aaf") - htShowPage() - -s19abf() == - page := htInitPage("S19ABF - Kelvin Function {\em bei x}", nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXs19abf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s19abf| '|NagSpecialFunctionsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\blankline ") - (text . "Evaluates the Kelvin function {\em bei x}") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the argument x: ") - (text . "\newline\tab{2} ") - (bcStrings (9 "0.1" x 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", 'sGen) - htpSetProperty(page,'routine,"s19abf") - htShowPage() - -s19acf() == - page := htInitPage("S19ACF - Kelvin Function {\em ker x}", nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXs19acf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s19acf| '|NagSpecialFunctionsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\blankline ") - (text . "Evaluates the Kelvin function {\em ker x}") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the argument x > 0.0: ") - (text . "\newline\tab{2} ") - (bcStrings (9 "0.1" x 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", 'sGen) - htpSetProperty(page,'routine,"s19acf") - htShowPage() - -s19adf() == - page := htInitPage("S19AAF - Kelvin Function {\em kei x}", nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXs19adf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s19adf| '|NagSpecialFunctionsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\blankline ") - (text . "Evaluates the Kelvin function {\em kei x}") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the argument x \inputbitmap{\htbmdir{}/great=.bitmap} 0.0: ") - (text . "\newline\tab{2} ") - (bcStrings (9 "0.0" x 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", 'sGen) - htpSetProperty(page,'routine,"s19adf") - htShowPage() - -s20acf() == - page := htInitPage("S20ACF - Fresnel Integral {\em S(x)}",nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXs20acf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s20acf| '|NagSpecialFunctionsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\blankline ") - (text . "Evaluates the Fresnel Integral {\em S(x)}") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the argument x: ") - (text . "\newline\tab{2} ") - (bcStrings (9 "0.5" x 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", 'sGen) - htpSetProperty(page,'routine,"s20acf") - htShowPage() - -s20adf() == - page := htInitPage("S20ADF - Fresnel Integral {\em C(x)}",nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXs20adf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s20adf| '|NagSpecialFunctionsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\blankline ") - (text . "Evaluates the Fresnel Integral {\em C(x)}") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the argument x: ") - (text . "\newline\tab{2} ") - (bcStrings (9 "0.5" x 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", 'sGen) - htpSetProperty(page,'routine,"s20adf") - htShowPage() - -s21baf() == - htInitPage("S21BAF - Degenerate Symmetrised Elliptic Integral of 1st Kind \vspace{-28} \inputbitmap{\htbmdir{}/s21baf1.bitmap}", nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXs21baf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s21baf| '|NagSpecialFunctionsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\blankline ") - (text . "Evaluates the elementary (degenerate symmetrised elliptic) ") - (text . " integral \space{1} \vspace{-28} \inputbitmap{\htbmdir{}/s21baf.bitmap} ") - (text . "\blankline ") - (text . "\newline ") - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") - (text . "Enter the argument x \space{1}\inputbitmap{\htbmdir{}/great=.bitmap} 0.0: ") - (text . "\tab{32} \menuitemstyle{}\tab{34} ") - (text . "Enter the argument y \notequal 0.0: ") - (text . "\newline\tab{2} ") - (bcStrings (10 "0.5" x F)) - (text . "\tab{34} ") - (bcStrings (10 "1.0" y 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", 's21bafGen) - htShowPage() - -s21bafGen htPage == - x := htpLabelInputString(htPage,'x) - y := htpLabelInputString(htPage,'y) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => 1 - -1 - linkGen STRCONC("s21baf(",x,'",",y,",",STRINGIMAGE ifail,'")") - -s21bbf() == - htInitPage("S21BBF - Symmetrised Elliptic Integral of 1st Kind \space{1} \vspace{-28} \inputbitmap{\htbmdir{}/s21bbf1.bitmap}", nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXs21bbf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s21bbf| '|NagSpecialFunctionsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\blankline ") - (text . "Evaluates the symmetrised elliptic integral of the first kind ") - (text . "\space{1} \vspace{-28} \inputbitmap{\htbmdir{}/s21bbf.bitmap} ") - (text . "\newline ") - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") - (text . "Enter the argument x \space{1}\inputbitmap{\htbmdir{}/great=.bitmap} 0.0: ") - (text . "\tab{32} \menuitemstyle{}\tab{34} ") - (text . "Enter the argument y \space{1}\inputbitmap{\htbmdir{}/great=.bitmap} 0.0: ") - (text . "\newline\tab{2} ") - (bcStrings (10 "0.5" x F)) - (text . "\tab{34} ") - (bcStrings (10 "1.0" y F)) - (text . "\blankline") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the argument z \space{1}\inputbitmap{\htbmdir{}/great=.bitmap} 0.0; ") - (text . "at most one of x,y and z may be equal to 0.0: \newline \tab{2}") - (bcStrings (10 "1.5" z 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", 's21bbfGen) - htShowPage() - -s21bbfGen htPage == - x := htpLabelInputString(htPage,'x) - y := htpLabelInputString(htPage,'y) - z := htpLabelInputString(htPage,'z) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => 1 - -1 - linkGen STRCONC("s21bbf(",x,'",",y,",",z,",",STRINGIMAGE ifail,'")") - -s21bcf() == - htInitPage("S21BCF - Symmetrised Elliptic Integral of 2nd Kind \space{1} \vspace{-28} \inputbitmap{\htbmdir{}/s21bcf1.bitmap}", nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXs21bcf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s21bcf| '|NagSpecialFunctionsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\blankline ") - (text . "Evaluates the symmetrised elliptic integral of the second kind ") - (text . "\space{1} \vspace{-28} \inputbitmap{\htbmdir{}/s21bcf.bitmap} ") - (text . "\newline ") - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") - (text . "Enter the argument x \space{1}\inputbitmap{\htbmdir{}/great=.bitmap} 0.0: ") - (text . "\tab{32} \menuitemstyle{}\tab{34} ") - (text . "Enter the argument y \space{1}\inputbitmap{\htbmdir{}/great=.bitmap} 0.0: ") - (text . "\newline\tab{2} ") - (bcStrings (10 "0.5" x F)) - (text . "\tab{34} ") - (bcStrings (10 "0.5" y F)) - (text . "\blankline") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the argument z > 0.0; ") - (text . "at most one of x, y and z may be equal to 0.0: \newline \tab{2}") - (bcStrings (10 "1.0" z 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", 's21bcfGen) - htShowPage() - -s21bcfGen htPage == - x := htpLabelInputString(htPage,'x) - y := htpLabelInputString(htPage,'y) - z := htpLabelInputString(htPage,'z) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => 1 - -1 - linkGen STRCONC("s21bcf(",x,'",",y,",",z,",",STRINGIMAGE ifail,'")") - -s21bdf() == - htInitPage("S21BDF - Symmetrised Elliptic Integral of 3rd Kind \space{1} \vspace{-28} \inputbitmap{\htbmdir{}/s21bdf1.bitmap}", nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXs21bdf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|s21bdf| '|NagSpecialFunctionsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\blankline ") - (text . "Evaluates the symmetrised elliptic integral of the third kind ") - (text . "\space{1} \vspace{-28} \inputbitmap{\htbmdir{}/s21bdf.bitmap} ") - (text . "\newline ") - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") - (text . "Enter the argument x \space{1}\inputbitmap{\htbmdir{}/great=.bitmap} 0.0: ") - (text . "\tab{32} \menuitemstyle{}\tab{34} ") - (text . "Enter the argument y \space{1}\inputbitmap{\htbmdir{}/great=.bitmap} 0.0: ") - (text . "\newline\tab{2} ") - (bcStrings (10 "0.5" x F)) - (text . "\tab{34} ") - (bcStrings (10 "0.5" y F)) - (text . "\blankline") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the argument z \space{1}\inputbitmap{\htbmdir{}/great=.bitmap} 0.0; ") - (text . "at most one of x, y and z may be equal to 0.0: \newline \tab{2}") - (bcStrings (10 "0.5" z F)) - (text . "\blankline") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the argument \rho \notequal 0.0: \newline \tab{2} ") - (bcStrings (10 "2.0" r 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", 's21bdfGen) - htShowPage() - -s21bdfGen htPage == - x := htpLabelInputString(htPage,'x) - y := htpLabelInputString(htPage,'y) - z := htpLabelInputString(htPage,'z) - r := htpLabelInputString(htPage,'r) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => 1 - -1 - linkGen STRCONC("s21bdf(",x,'",",y,",",z,",",r,",",STRINGIMAGE ifail,'")") - -sGen htPage == - routine := htpProperty(htPage,'routine) - x := htpLabelInputString(htPage,'x) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => 1 - -1 - linkGen STRCONC(routine,"(",x,'",",STRINGIMAGE ifail,'")") - -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/showimp.boot b/src/interp/showimp.boot new file mode 100644 index 00000000..c6af476a --- /dev/null +++ b/src/interp/showimp.boot @@ -0,0 +1,252 @@ +-- 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. + + +)package "BOOT" + +$returnNowhereFromGoGet := false + +showSummary dom == + showPredicates dom + showAttributes dom + showFrom dom + showImp dom + +--======================================================================= +-- Show Where Functions in Domain are Implemented +--======================================================================= +showImp(dom,:options) == + sayBrightly '"-------------Operation summary-----------------" + missingOnlyFlag := KAR options + domainForm := devaluate dom + [nam,:$domainArgs] := domainForm + $predicateList: local := GETDATABASE(nam,'PREDICATES) + predVector := dom.3 + u := getDomainOpTable(dom,true) + --sort into 4 groups: domain exports, unexports, default exports, others + for (x := [.,.,:key]) in u repeat + key = domainForm => domexports := [x,:domexports] + FIXP key => unexports := [x,:unexports] + isDefaultPackageForm? key => defexports := [x,:defexports] + key = 'nowhere => nowheres := [x,:nowheres] + key = 'constant => constants := [x,:constants] + others := [x,:others] --add chain domains go here + sayBrightly + nowheres => ['"Functions exported but not implemented by", + :bright form2String domainForm,'":"] + [:bright form2String domainForm,'"implements all exported operations"] + showDomainsOp1(nowheres,'nowhere) + missingOnlyFlag => 'done + + --first display those exported by the domain, then add chain guys + u := [:domexports,:constants,:SORTBY('CDDR,others)] + while u repeat + [.,.,:key] := CAR u + sayBrightly + key = 'constant => + ["Constants implemented by",:bright form2String key,'":"] + ["Functions implemented by",:bright form2String key,'":"] + u := showDomainsOp1(u,key) + u := SORTBY('CDDR,defexports) + while u repeat + [.,.,:key] := CAR u + defop := INTERN(SUBSTRING((s := PNAME CAR key),0,MAXINDEX s)) + domainForm := [defop,:CDDR key] + sayBrightly ["Default functions from",:bright form2String domainForm,'":"] + u := showDomainsOp1(u,key) + u := SORTBY('CDDR,unexports) + while u repeat + [.,.,:key] := CAR u + sayBrightly ["Not exported: "] + u := showDomainsOp1(u,key) + +--======================================================================= +-- Show Information Directly From Domains +--======================================================================= +showFrom(D,:option) == + ops := KAR option + alist := nil + domainForm := devaluate D + [nam,:.] := domainForm + $predicateList: local := GETDATABASE(nam,'PREDICATES) + for (opSig := [op,sig]) in getDomainSigs1(D,ops) repeat + u := from?(D,op,sig) + x := ASSOC(u,alist) => RPLACD(x,[opSig,:rest x]) + alist := [[u,opSig],:alist] + for [conform,:l] in alist repeat + sayBrightly concat('"From ",form2String conform,'":") + for [op,sig] in l repeat sayBrightly ['" ",:formatOpSignature(op,sig)] + +--======================================================================= +-- Functions implementing showFrom +--======================================================================= +getDomainOps D == + domname := D.0 + conname := CAR domname + $predicateList: local := GETDATABASE(conname,'PREDICATES) + REMDUP listSort(function GLESSEQP,ASSOCLEFT getDomainOpTable(D,nil)) + +getDomainSigs(D,:option) == + domname := D.0 + conname := CAR domname + $predicateList: local := GETDATABASE(conname,'PREDICATES) + getDomainSigs1(D,first option) + +getDomainSigs1(D,ops) == listSort(function GLESSEQP,u) where + u() == [x for x in getDomainOpTable(D,nil) | null ops or MEMQ(CAR x,ops)] + +getDomainDocs(D,:option) == + domname := D.0 + conname := CAR domname + $predicateList: local := GETDATABASE(conname,'PREDICATES) + ops := KAR option + [[op,sig,:getInheritanceByDoc(D,op,sig)] for [op,sig] in getDomainSigs1(D,ops)] + +--======================================================================= +-- Getting Inheritance Info from Documentation in Lisplib +--======================================================================= +from?(D,op,sig) == KAR KDR getInheritanceByDoc(D,op,sig) + +getExtensionsOfDomain domain == + u := getDomainExtensionsOfDomain domain + cats := getCategoriesOfDomain domain + for x in u repeat + cats := union(cats,getCategoriesOfDomain EVAL x) + [:u,:cats] + +getDomainExtensionsOfDomain domain == + acc := nil + d := domain + while (u := devaluateSlotDomain(5,d)) repeat + acc := [u,:acc] + d := EVAL u + acc + +devaluateSlotDomain(u,dollar) == + u = '$ => devaluate dollar + FIXP u and VECP (y := dollar.u) => devaluate y + u is ['NRTEVAL,y] => MKQ eval y + u is ['QUOTE,y] => u + u is [op,:argl] => [op,:[devaluateSlotDomain(x,dollar) for x in argl]] + devaluate evalSlotDomain(u,dollar) + +getCategoriesOfDomain domain == + predkeyVec := domain.4.0 + catforms := CADR domain.4 + [fn for i in 0..MAXINDEX predkeyVec | test] where + test() == predkeyVec.i and + (x := catforms . i) isnt ['DomainSubstitutionMacro,:.] + fn() == + VECP x => devaluate x + devaluateSlotDomain(x,domain) + +getInheritanceByDoc(D,op,sig,:options) == +--gets inheritance and documentation information by looking in the LISPLIB +--for each ancestor of the domain + catList := KAR options or getExtensionsOfDomain D + getDocDomainForOpSig(op,sig,devaluate D,D) or + or/[fn for x in catList] or '(NIL NIL) + where fn() == getDocDomainForOpSig(op,sig,substDomainArgs(D,x),D) + +getDocDomainForOpSig(op,sig,dollar,D) == + (u := LASSOC(op,GETDATABASE(CAR dollar,'DOCUMENTATION))) + and (doc := or/[[d,dollar] for [s,:d] in u | compareSig(sig,s,D,dollar)]) + +--======================================================================= +-- Functions implementing showImp +--======================================================================= +showDomainsOp1(u,key) == + while u and CAR u is [op,sig,: =key] repeat + sayBrightly ['" ",:formatOpSignature(op,sig)] + u := rest u + u + +getDomainRefName(dom,nam) == + PAIRP nam => [getDomainRefName(dom,x) for x in nam] + not FIXP nam => nam + slot := dom.nam + VECP slot => slot.0 + slot is ['SETELT,:.] => getDomainRefName(dom,getDomainSeteltForm slot) + slot + +getDomainSeteltForm ['SETELT,.,.,form] == + form is ['evalSlotDomain,u,d] => devaluateSlotDomain(u,d) + VECP form => systemError() + form + +showPredicates dom == + sayBrightly '"--------------------Predicate summary-------------------" + conname := CAR dom.0 + predvector := dom.3 + predicateList := GETDATABASE(conname,'PREDICATES) + for i in 1.. for p in predicateList repeat + prefix := + testBitVector(predvector,i) => '"true : " + '"false: " + sayBrightly [prefix,:pred2English p] + +showAttributes dom == + sayBrightly '"--------------------Attribute summary-------------------" + conname := CAR dom.0 + abb := getConstructorAbbreviation conname + predvector := dom.3 + for [a,:p] in dom.2 repeat + prefix := + testBitVector(predvector,p) => '"true : " + '"false: " + sayBrightly concat(prefix,form2String a) + +showGoGet dom == + numvec := CDDR dom.4 + for i in 6..MAXINDEX dom | (slot := dom.i) is ['newGoGet,dol,index,:op] repeat + numOfArgs := numvec.index + whereNumber := numvec.(index := index + 1) + signumList := + [formatLazyDomainForm(dom,numvec.(index + i)) for i in 0..numOfArgs] + index := index + numOfArgs + 1 + namePart := + concat(bright "from",form2String formatLazyDomainForm(dom,whereNumber)) + sayBrightly [i,'": ",:formatOpSignature(op,signumList),:namePart] + +formatLazyDomain(dom,x) == + VECP x => devaluate x + x is [dollar,slotNumber,:form] => formatLazyDomainForm(dom,form) + systemError nil + +formatLazyDomainForm(dom,x) == + x = 0 => ["$"] + FIXP x => formatLazyDomain(dom,dom.x) + atom x => x + x is ['NRTEVAL,y] => (atom y => [y]; y) + [first x,:[formatLazyDomainForm(dom,y) for y in rest x]] + + + diff --git a/src/interp/showimp.boot.pamphlet b/src/interp/showimp.boot.pamphlet deleted file mode 100644 index 0e1d1865..00000000 --- a/src/interp/showimp.boot.pamphlet +++ /dev/null @@ -1,278 +0,0 @@ -\documentclass{article} -\usepackage{axiom} - -\title{\File{src/interp/showimp.boot} Pamphlet} -\author{The Axiom Team} - -\begin{document} -\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. - -@ -<<*>>= -<> - -)package "BOOT" - -$returnNowhereFromGoGet := false - -showSummary dom == - showPredicates dom - showAttributes dom - showFrom dom - showImp dom - ---======================================================================= --- Show Where Functions in Domain are Implemented ---======================================================================= -showImp(dom,:options) == - sayBrightly '"-------------Operation summary-----------------" - missingOnlyFlag := KAR options - domainForm := devaluate dom - [nam,:$domainArgs] := domainForm - $predicateList: local := GETDATABASE(nam,'PREDICATES) - predVector := dom.3 - u := getDomainOpTable(dom,true) - --sort into 4 groups: domain exports, unexports, default exports, others - for (x := [.,.,:key]) in u repeat - key = domainForm => domexports := [x,:domexports] - FIXP key => unexports := [x,:unexports] - isDefaultPackageForm? key => defexports := [x,:defexports] - key = 'nowhere => nowheres := [x,:nowheres] - key = 'constant => constants := [x,:constants] - others := [x,:others] --add chain domains go here - sayBrightly - nowheres => ['"Functions exported but not implemented by", - :bright form2String domainForm,'":"] - [:bright form2String domainForm,'"implements all exported operations"] - showDomainsOp1(nowheres,'nowhere) - missingOnlyFlag => 'done - - --first display those exported by the domain, then add chain guys - u := [:domexports,:constants,:SORTBY('CDDR,others)] - while u repeat - [.,.,:key] := CAR u - sayBrightly - key = 'constant => - ["Constants implemented by",:bright form2String key,'":"] - ["Functions implemented by",:bright form2String key,'":"] - u := showDomainsOp1(u,key) - u := SORTBY('CDDR,defexports) - while u repeat - [.,.,:key] := CAR u - defop := INTERN(SUBSTRING((s := PNAME CAR key),0,MAXINDEX s)) - domainForm := [defop,:CDDR key] - sayBrightly ["Default functions from",:bright form2String domainForm,'":"] - u := showDomainsOp1(u,key) - u := SORTBY('CDDR,unexports) - while u repeat - [.,.,:key] := CAR u - sayBrightly ["Not exported: "] - u := showDomainsOp1(u,key) - ---======================================================================= --- Show Information Directly From Domains ---======================================================================= -showFrom(D,:option) == - ops := KAR option - alist := nil - domainForm := devaluate D - [nam,:.] := domainForm - $predicateList: local := GETDATABASE(nam,'PREDICATES) - for (opSig := [op,sig]) in getDomainSigs1(D,ops) repeat - u := from?(D,op,sig) - x := ASSOC(u,alist) => RPLACD(x,[opSig,:rest x]) - alist := [[u,opSig],:alist] - for [conform,:l] in alist repeat - sayBrightly concat('"From ",form2String conform,'":") - for [op,sig] in l repeat sayBrightly ['" ",:formatOpSignature(op,sig)] - ---======================================================================= --- Functions implementing showFrom ---======================================================================= -getDomainOps D == - domname := D.0 - conname := CAR domname - $predicateList: local := GETDATABASE(conname,'PREDICATES) - REMDUP listSort(function GLESSEQP,ASSOCLEFT getDomainOpTable(D,nil)) - -getDomainSigs(D,:option) == - domname := D.0 - conname := CAR domname - $predicateList: local := GETDATABASE(conname,'PREDICATES) - getDomainSigs1(D,first option) - -getDomainSigs1(D,ops) == listSort(function GLESSEQP,u) where - u() == [x for x in getDomainOpTable(D,nil) | null ops or MEMQ(CAR x,ops)] - -getDomainDocs(D,:option) == - domname := D.0 - conname := CAR domname - $predicateList: local := GETDATABASE(conname,'PREDICATES) - ops := KAR option - [[op,sig,:getInheritanceByDoc(D,op,sig)] for [op,sig] in getDomainSigs1(D,ops)] - ---======================================================================= --- Getting Inheritance Info from Documentation in Lisplib ---======================================================================= -from?(D,op,sig) == KAR KDR getInheritanceByDoc(D,op,sig) - -getExtensionsOfDomain domain == - u := getDomainExtensionsOfDomain domain - cats := getCategoriesOfDomain domain - for x in u repeat - cats := union(cats,getCategoriesOfDomain EVAL x) - [:u,:cats] - -getDomainExtensionsOfDomain domain == - acc := nil - d := domain - while (u := devaluateSlotDomain(5,d)) repeat - acc := [u,:acc] - d := EVAL u - acc - -devaluateSlotDomain(u,dollar) == - u = '$ => devaluate dollar - FIXP u and VECP (y := dollar.u) => devaluate y - u is ['NRTEVAL,y] => MKQ eval y - u is ['QUOTE,y] => u - u is [op,:argl] => [op,:[devaluateSlotDomain(x,dollar) for x in argl]] - devaluate evalSlotDomain(u,dollar) - -getCategoriesOfDomain domain == - predkeyVec := domain.4.0 - catforms := CADR domain.4 - [fn for i in 0..MAXINDEX predkeyVec | test] where - test() == predkeyVec.i and - (x := catforms . i) isnt ['DomainSubstitutionMacro,:.] - fn() == - VECP x => devaluate x - devaluateSlotDomain(x,domain) - -getInheritanceByDoc(D,op,sig,:options) == ---gets inheritance and documentation information by looking in the LISPLIB ---for each ancestor of the domain - catList := KAR options or getExtensionsOfDomain D - getDocDomainForOpSig(op,sig,devaluate D,D) or - or/[fn for x in catList] or '(NIL NIL) - where fn() == getDocDomainForOpSig(op,sig,substDomainArgs(D,x),D) - -getDocDomainForOpSig(op,sig,dollar,D) == - (u := LASSOC(op,GETDATABASE(CAR dollar,'DOCUMENTATION))) - and (doc := or/[[d,dollar] for [s,:d] in u | compareSig(sig,s,D,dollar)]) - ---======================================================================= --- Functions implementing showImp ---======================================================================= -showDomainsOp1(u,key) == - while u and CAR u is [op,sig,: =key] repeat - sayBrightly ['" ",:formatOpSignature(op,sig)] - u := rest u - u - -getDomainRefName(dom,nam) == - PAIRP nam => [getDomainRefName(dom,x) for x in nam] - not FIXP nam => nam - slot := dom.nam - VECP slot => slot.0 - slot is ['SETELT,:.] => getDomainRefName(dom,getDomainSeteltForm slot) - slot - -getDomainSeteltForm ['SETELT,.,.,form] == - form is ['evalSlotDomain,u,d] => devaluateSlotDomain(u,d) - VECP form => systemError() - form - -showPredicates dom == - sayBrightly '"--------------------Predicate summary-------------------" - conname := CAR dom.0 - predvector := dom.3 - predicateList := GETDATABASE(conname,'PREDICATES) - for i in 1.. for p in predicateList repeat - prefix := - testBitVector(predvector,i) => '"true : " - '"false: " - sayBrightly [prefix,:pred2English p] - -showAttributes dom == - sayBrightly '"--------------------Attribute summary-------------------" - conname := CAR dom.0 - abb := getConstructorAbbreviation conname - predvector := dom.3 - for [a,:p] in dom.2 repeat - prefix := - testBitVector(predvector,p) => '"true : " - '"false: " - sayBrightly concat(prefix,form2String a) - -showGoGet dom == - numvec := CDDR dom.4 - for i in 6..MAXINDEX dom | (slot := dom.i) is ['newGoGet,dol,index,:op] repeat - numOfArgs := numvec.index - whereNumber := numvec.(index := index + 1) - signumList := - [formatLazyDomainForm(dom,numvec.(index + i)) for i in 0..numOfArgs] - index := index + numOfArgs + 1 - namePart := - concat(bright "from",form2String formatLazyDomainForm(dom,whereNumber)) - sayBrightly [i,'": ",:formatOpSignature(op,signumList),:namePart] - -formatLazyDomain(dom,x) == - VECP x => devaluate x - x is [dollar,slotNumber,:form] => formatLazyDomainForm(dom,form) - systemError nil - -formatLazyDomainForm(dom,x) == - x = 0 => ["$"] - FIXP x => formatLazyDomain(dom,dom.x) - atom x => x - x is ['NRTEVAL,y] => (atom y => [y]; y) - [first x,:[formatLazyDomainForm(dom,y) for y in rest x]] - - - -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/topics.boot.pamphlet b/src/interp/topics.boot.pamphlet deleted file mode 100644 index a269b18c..00000000 --- a/src/interp/topics.boot.pamphlet +++ /dev/null @@ -1,263 +0,0 @@ -\documentclass{article} -\usepackage{axiom} - -\title{\File{src/interp/topics.boot} Pamphlet} -\author{The Axiom Team} - -\begin{document} -\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. - -@ -<<*>>= -<> - -$topicsDefaults := '( - (basic elt setelt qelt qsetelt eval xRange yRange zRange map map! qsetelt!) - (conversion coerce convert retract) - (hidden retractIfCan Zero One) - (predicate _< _=) - (algebraic _+ _- _* _*_* _/ quo rem exquo) - (trignometric acos acot acsc asec asin atan cos cot csc sec sin tan) - (hyperbolic acosh acoth acsch asech asinh atanh cosh coth csch sech sinh tanh) - (destructive setelt qsetelt) - (extraction xRange yRange zRange elt qelt) - (transformation map map!)) - -$topicSynonyms := '( - (b . basic) - (h . hidden) - (e . extended) - (a . algebraic) - (g . algebraic) - (c . construct) - (d . destructive) - (v . conversion) - (m . miscellaneous) - (x . extraction) - (p . predicate) - (tg . trignometric) - (hy . hyperbolic) - (t . transformation)) - -$groupAssoc := '((extended . 1) (basic . 2) (hidden . 4)) - ---======================================================================= --- Create Hashtable of Operation Properties ---======================================================================= ---called at build-time before making DOCUMENTATION property -mkTopicHashTable() == --given $groupAssoc = ((extended . 1)(basic . 2)(xx . 4)..) - $defaultsHash := MAKE_-HASHTABLE 'ID --keys are ops, value is list of topic names - for [kind,:items] in $topicsDefaults repeat --$topicsDefaults is (( op ...) ..) - for item in items repeat - HPUT($defaultsHash,item,[kind,:HGET($defaultsHash,item)]) - $conTopicHash := MAKE_-HASHTABLE 'EQL --key is constructor name; value is - instream := OPEN '"topics.data" - while not EOFP instream repeat - line := READLINE instream - while blankLine? line repeat line := READLINE instream - m := MAXINDEX line --file "topics.data" has form: - m = -1 => 'skip --1 ConstructorName: - line.0 = char '_- => 'skip --2 constructorName or operation name - line := trimString line --3-n ... - m := MAXINDEX line -- (blank line) ... - line.m ^= (char '_:) => systemError('"wrong heading") - con := INTERN SUBSTRING(line,0,m) - alist := [lst while not EOFP instream and - not (blankLine? (line := READLINE instream)) and - line.0 ^= char '_- for i in 1.. - | lst := string2OpAlist line] - alist => HPUT($conTopicHash,con,alist) - --initialize table of topic classes - $topicHash := MAKE_-HASHTABLE 'ID --$topicHash has keys: topic and value: index - for [x,:c] in $groupAssoc repeat HPUT($topicHash,x,c) - $topicIndex := CDR LAST $groupAssoc - - --replace each property list by a topic code - --store under each construct an OR of all codes - for con in HKEYS $conTopicHash repeat - conCode := 0 - for pair in HGET($conTopicHash,con) repeat - RPLACD(pair,code := topicCode CDR pair) - conCode := LOGIOR(conCode,code) - HPUT($conTopicHash,con, - [['constructor,:conCode],:HGET($conTopicHash,con)]) - SHUT instream - ---reduce integers stored under names to 1 + its power of 2 - for key in HKEYS $topicHash repeat - HPUT($topicHash,key,INTEGER_-LENGTH HGET($topicHash,key)) - - $conTopicHash --keys are ops or 'constructor', values are codes - -blankLine? line == - MAXINDEX line = -1 or and/[line . j = (char '_ ) for j in 0..MAXINDEX line] - -string2OpAlist s == - m := #s - k := skipBlanks(s,0,m) or return nil - UPPER_-CASE_-P s.k => nil --skip constructor names - k := 0 - while (k := skipBlanks(s,k,m)) repeat - acc := [INTERN SUBSTRING(s,k,-k + (k := charPosition(char '_ ,s,k + 1))),:acc] - acc := NREVERSE acc - --now add defaults - if u := getDefaultProps first acc then acc := [first acc,:u,:rest acc] - acc - -getDefaultProps name == - u := HGET($defaultsHash,name) - if (s := PNAME name).(m := MAXINDEX s) = char '? then u := ['p,:u] - if s.m = char '_! then u := ['destructive,:u] - u - -skipBlanks(u,i,m) == - while i < m and u.i = $charBlank repeat i := i + 1 - i >= m => nil - i - ---======================================================================= --- Compute Topic Code for Operation ---======================================================================= -topicCode lst == - u := [y for x in lst] where y == - rename := LASSOC(x,$topicSynonyms) => rename - x - if null intersection('(basic extended hidden),u) then u := ['extended,:u] - bitIndexList := nil - for x in REMDUP u repeat - bitIndexList := [fn x,:bitIndexList] where fn x == - k := HGET($topicHash,x) => k - HPUT($topicHash,x,$topicIndex := $topicIndex * 2) - $topicIndex - code := +/[i for i in bitIndexList] - ---======================================================================= --- Add Codes to Documentation Property ---======================================================================= ---called to modify DOCUMENTATION property for each "con" -addTopic2Documentation(con,docAlist) == - alist := HGET($conTopicHash,con) or return docAlist - [y for x in docAlist] where y == - [op,:pairlist] := x - code := LASSOC(op,alist) or 0 - for sigDoc in pairlist repeat - sigDoc is [.,.] => RPLACD(rest sigDoc,code) - systemError sigDoc - docAlist - ---======================================================================= --- Test: Display Topics for a given constructor ---======================================================================= -td con == - $topicClasses := ASSOCRIGHT mySort - [[HGET($topicHash,key),:key] for key in HKEYS $topicHash] - hash := MAKE_-HASHTABLE 'ID - tdAdd(con,hash) - tdPrint hash - -tdAdd(con,hash) == - v := HGET($conTopicHash,con) - u := addTopic2Documentation(con,v) ---u := GETDATABASE(con,'DOCUMENTATION) - for pair in u | FIXP (code := myLastAtom pair) and (op := CAR pair) ^= 'construct repeat - for x in (names := code2Classes code) repeat HPUT(hash,x,insert(op,HGET(hash,x))) - -tdPrint hash == - for key in mySort HKEYS hash repeat - sayBrightly [key,'":"] - sayBrightlyNT '" " - for x in HGET(hash,key) repeat sayBrightlyNT ['" ",x] - TERPRI() - -topics con == - --assumes that DOCUMENTATION property already has #s added - $topicClasses := ASSOCRIGHT mySort - [[HGET($topicHash,key),:key] for key in HKEYS $topicHash] - hash := MAKE_-HASHTABLE 'ID - tdAdd(con,hash) - for x in REMDUP [CAAR y for y in ancestorsOf(getConstructorForm con,nil)] repeat - tdAdd(x,hash) - for x in HKEYS hash repeat HPUT(hash,x,mySort HGET(hash,x)) - tdPrint hash - -code2Classes cc == - cc := 2*cc - [x while cc ^= 0 for x in $topicClasses | ODDP (cc := QUOTIENT(cc,2))] - -myLastAtom x == - while x is [.,:x] repeat nil - x - ---======================================================================= --- Transfer Codes to opAlist ---======================================================================= - -transferClassCodes(conform,opAlist) == - transferCodeCon(opOf conform,opAlist) - for x in ancestorsOf(conform,nil) repeat - transferCodeCon(CAAR x,opAlist) - -transferCodeCon(con,opAlist) == - for pair in GETDATABASE(con,'DOCUMENTATION) - | FIXP (code := myLastAtom pair) repeat - u := ASSOC(QCAR pair,opAlist) => RPLACD(LASTNODE u,code) - ---======================================================================= --- Filter Operation by Topic ---======================================================================= - -filterByTopic(opAlist,topic) == - bitNumber := HGET($topicHash,topic) - [x for x in opAlist - | FIXP (code := myLastAtom x) and LOGBITP(bitNumber,code)] - -listOfTopics(conname) == - doc := GETDATABASE(conname,'DOCUMENTATION) - u := ASSOC('constructor,doc) or return nil - code := myLastAtom u ---null FIXP code => nil - mySort [key for key in HKEYS($topicHash) | LOGBITP(HGET($topicHash,key),code)] - -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} -- cgit v1.2.3