aboutsummaryrefslogtreecommitdiff
path: root/src/interp
diff options
context:
space:
mode:
Diffstat (limited to 'src/interp')
-rw-r--r--src/interp/ChangeLog54
-rw-r--r--src/interp/Makefile.in64
-rw-r--r--src/interp/Makefile.pamphlet76
-rw-r--r--src/interp/anna.boot1910
-rw-r--r--src/interp/nag-c02.boot299
-rw-r--r--src/interp/nag-c05.boot407
-rw-r--r--src/interp/nag-c06.boot1837
-rw-r--r--src/interp/nag-d01.boot1342
-rw-r--r--src/interp/nag-d02.boot2151
-rw-r--r--src/interp/nag-d03.boot644
-rw-r--r--src/interp/nag-e01.boot1763
-rw-r--r--src/interp/nag-e02.boot4676
-rw-r--r--src/interp/nag-e02b.boot1740
-rw-r--r--src/interp/nag-e04.boot2503
-rw-r--r--src/interp/nag-f01.boot2235
-rw-r--r--src/interp/nag-f02.boot2738
-rw-r--r--src/interp/nag-f04.boot2314
-rw-r--r--src/interp/nag-f07.boot709
-rw-r--r--src/interp/nag-s.boot1587
-rw-r--r--src/interp/patches.lisp1
-rw-r--r--src/interp/setq.lisp6
-rw-r--r--src/interp/setvars.boot59
-rw-r--r--src/interp/setvart.boot116
-rw-r--r--src/interp/sockio.lisp2
-rw-r--r--src/interp/util.lisp124
25 files changed, 65 insertions, 29292 deletions
diff --git a/src/interp/ChangeLog b/src/interp/ChangeLog
index 3796a75e..6088d4d8 100644
--- a/src/interp/ChangeLog
+++ b/src/interp/ChangeLog
@@ -1,3 +1,57 @@
+2007-11-29 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
+ * Makefile.pamphlet (NAGBROBJS): Remove.
+ (makeint.lisp): Don't depend on it, don't use it.
+ (UNUSED): Remove reference to anna.boot.
+ (nag-s.$(FASLEXT)): Remove.
+ (nag-f07.$(FASLEXT)): Likewise.
+ (nag-f04.$(FASLEXT)): Likewise.
+ (nag-f02.$(FASLEXT)): Likewise.
+ (nag-f01.$(FASLEXT)): Likewise.
+ (nag-e04.$(FASLEXT)): Likewise.
+ (nag-e02.$(FASLEXT)): Likewise.
+ (nag-e02b.$(FASLEXT)): Likewise.
+ (nag-e01.$(FASLEXT)): Likewise.
+ (nag-d03.$(FASLEXT)): Likewise.
+ (nag-d02.$(FASLEXT)): Likewise.
+ (nag-d01.$(FASLEXT)): Likewise.
+ (nag-c06.$(FASLEXT)): Likewise.
+ (nag-c05.$(FASLEXT)): Likewise.
+ (nag-c02.$(FASLEXT)): Likewise.
+ anna.boot: Remove.
+ nag-s.boot: Likewise.
+ nag-f07.boot: Likewise.
+ nag-f04.boot: Likewise.
+ nag-f02.boot: Likewise.
+ nag-f01.boot: Likewise.
+ nag-e04.boot: Likewise.
+ nag-e02.boot: Likewise.
+ nag-e02b.boot: Likewise.
+ nag-e01.boot: Likewise.
+ nag-d03.boot: Likewise.
+ nag-d02.boot: Likewise.
+ nag-d01.boot: Likewise.
+ nag-c06.boot: Likewise.
+ nag-c05.boot: Likewise.
+ nag-c02.boot: Likewise.
+ * setq.lisp (|$localExposureDataDefault|): Remove reference to naglink.
+ (|$localExposureData|): Likewise.
+ (|$InitialCommandSynonymAlist|): Remove startNAGLink and stopNAGLink.
+ * setvars.boot (setNagHost): Remove.
+ (describeSetNagHost): Likewise.
+ (setFortPers): Likewise.
+ (describeSetFortPers): Likewise.
+ * setvart.boot: Remove naglink option.
+ * sockio.lisp (NAGLinkServer): Remove.
+ * util.lisp (anna-functions): Likewise.
+ (nagbr-functions): Likewise.
+ (build-interpsys): Lose nagbr-files parameter.
+ (setNAGBootAutoloadProperties): Remove.
+ (get-NAG-chapter): Likewise.
+ (nag-files): Likewise.
+ (chapter-name): Likewise.
+ (sourcepath): Don't set naglink.
+
2007-11-28 Gabriel Dos Reis <gdr@cs.tamu.edu>
* Makefile.pamphlet (INOBJS): Don't include intint.$(FASLEXT).
diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in
index 70bfb783..7ec3057e 100644
--- a/src/interp/Makefile.in
+++ b/src/interp/Makefile.in
@@ -125,16 +125,6 @@ TRANOBJS= ${AUTO}/wi1.$(FASLEXT) ${AUTO}/wi2.$(FASLEXT) ${AUTO}/pspad1.$(FASLEXT
autoload_objects += $(TRANOBJS)
-NAGBROBJS= ${AUTO}/nag-c02.$(FASLEXT) ${AUTO}/nag-c05.$(FASLEXT) \
- ${AUTO}/nag-c06.$(FASLEXT) ${AUTO}/nag-d01.$(FASLEXT) \
- ${AUTO}/nag-d02.$(FASLEXT) ${AUTO}/nag-d03.$(FASLEXT) \
- ${AUTO}/nag-e01.$(FASLEXT) ${AUTO}/nag-e02.$(FASLEXT) \
- ${AUTO}/nag-e04.$(FASLEXT) ${AUTO}/nag-f01.$(FASLEXT) \
- ${AUTO}/nag-f02.$(FASLEXT) ${AUTO}/nag-f04.$(FASLEXT) \
- ${AUTO}/nag-f07.$(FASLEXT) ${AUTO}/nag-s.$(FASLEXT)
-
-autoload_objects += $(NAGBROBJS)
-
ASCOMP= hashcode.$(FASLEXT) as.$(FASLEXT) \
foam_l.$(FASLEXT) axext_l.$(FASLEXT)
@@ -152,7 +142,7 @@ YEARWEEK=(progn (setq boot::timestamp "${TIMESTAMP}") \
.PRECIOUS: ${SAVESYS}
.PRECIOUS: ${AXIOMSYS}
-UNUSED= ${DOC}/anna.boot.dvi ${DOC}/construc.lisp.dvi \
+UNUSED= ${DOC}/construc.lisp.dvi \
${DOC}/domain.lisp.dvi ${DOC}/guess.boot.dvi \
${DOC}/interp-fix.boot.dvi \
${DOC}/nhyper.boot.dvi ${DOC}/pf2atree.boot.dvi \
@@ -209,7 +199,7 @@ makeint.lisp: ${OBJS} bookvol5.$(FASLEXT) util.$(FASLEXT) \
sys-driver.$(FASLEXT) \
${OUTINTERP} obey.$(FASLEXT) \
database.date ${INOBJS} ${ASCOMP} ${ASAUTO} \
- ${NAGBROBJS} ${TRANOBJS} \
+ ${TRANOBJS} \
${LOADSYS} \
$(axiom_targetdir)/algebra/exposed.$(FASLEXT) \
$(axiom_src_docdir)/msgs/s2-us.msgs \
@@ -229,7 +219,7 @@ makeint.lisp: ${OBJS} bookvol5.$(FASLEXT) util.$(FASLEXT) \
@ echo '(in-package "BOOT")' >> makeint.lisp
@ touch ${TIMESTAMP}
@ echo '${YEARWEEK}' >> makeint.lisp
- @ echo '(boot::build-interpsys (append (quote ($(interpsys_modules))) (quote ($(AS_modules))) (quote ($(IN_modules)))) (quote ($(patsubst %, "%", ${TRANOBJS}))) (quote ($(patsubst %, "%", ${NAGBROBJS}))) (quote ($(patsubst %, "%", ${ASAUTO}))))' >> makeint.lisp
+ @ echo '(boot::build-interpsys (append (quote ($(interpsys_modules))) (quote ($(AS_modules))) (quote ($(IN_modules)))) (quote ($(patsubst %, "%", ${TRANOBJS}))) (quote ($(patsubst %, "%", ${ASAUTO}))))' >> makeint.lisp
@ echo '(boot::set-restart-hook)' >> makeint.lisp
@ echo '(in-package "BOOT")' >> makeint.lisp
@ echo '(load "../algebra/warm.data")' >> makeint.lisp
@@ -277,54 +267,6 @@ database.date:
$(AUTO)/%.$(FASLEXT): %.$(FASLEXT)
$(INSTALL) $< $@
-## NAG Links and Friends
-
-nag-s.$(FASLEXT): nag-s.boot macros.$(FASLEXT)
- $(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $<
-
-nag-f07.$(FASLEXT): nag-f07.boot macros.$(FASLEXT)
- $(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $<
-
-nag-f04.$(FASLEXT): nag-f04.boot macros.$(FASLEXT)
- $(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $<
-
-nag-f02.$(FASLEXT): nag-f02.boot macros.$(FASLEXT)
- $(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $<
-
-nag-f01.$(FASLEXT): nag-f01.boot macros.$(FASLEXT)
- $(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $<
-
-nag-e04.$(FASLEXT): nag-e04.boot macros.$(FASLEXT)
- $(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $<
-
-nag-e02.$(FASLEXT): nag-e02.boot macros.$(FASLEXT)
- $(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $<
-
-nag-e02b.$(FASLEXT): nag-e02b.boot macros.$(FASLEXT)
- $(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $<
-
-nag-e01.$(FASLEXT): nag-e01.boot macros.$(FASLEXT)
- $(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $<
-
-nag-d03.$(FASLEXT): nag-d03.boot macros.$(FASLEXT)
- $(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $<
-
-nag-d02.$(FASLEXT): nag-d02.boot macros.$(FASLEXT)
- $(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $<
-
-nag-d01.$(FASLEXT): nag-d01.boot macros.$(FASLEXT)
- $(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $<
-
-nag-c06.$(FASLEXT): nag-c06.boot macros.$(FASLEXT)
- $(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $<
-
-nag-c05.$(FASLEXT): nag-c05.boot macros.$(FASLEXT)
- $(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $<
-
-nag-c02.$(FASLEXT): nag-c02.boot macros.$(FASLEXT)
- $(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $<
-
-
## Translation to Fortran
fortcall.$(FASLEXT): fortcall.boot sys-macros.$(FASLEXT)
$(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $<
diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet
index f1d11c57..f126db96 100644
--- a/src/interp/Makefile.pamphlet
+++ b/src/interp/Makefile.pamphlet
@@ -280,24 +280,6 @@ autoload_objects += $(TRANOBJS)
@
-The {\bf NAGBROBJS} list contains files used to access the
-Numerical Algorithms Group (NAG) fortran libraries.
-These files should probably be autoloaded.
-Note that [[${AUTO}/nag-e02a.$(FASLEXT)]] is not included in this
-list as it is a subset of [[${AUTO}/nag-e02.$(FASLEXT)]].
-<<environment>>=
-NAGBROBJS= ${AUTO}/nag-c02.$(FASLEXT) ${AUTO}/nag-c05.$(FASLEXT) \
- ${AUTO}/nag-c06.$(FASLEXT) ${AUTO}/nag-d01.$(FASLEXT) \
- ${AUTO}/nag-d02.$(FASLEXT) ${AUTO}/nag-d03.$(FASLEXT) \
- ${AUTO}/nag-e01.$(FASLEXT) ${AUTO}/nag-e02.$(FASLEXT) \
- ${AUTO}/nag-e04.$(FASLEXT) ${AUTO}/nag-f01.$(FASLEXT) \
- ${AUTO}/nag-f02.$(FASLEXT) ${AUTO}/nag-f04.$(FASLEXT) \
- ${AUTO}/nag-f07.$(FASLEXT) ${AUTO}/nag-s.$(FASLEXT)
-
-autoload_objects += $(NAGBROBJS)
-
-@
-
The {\bf ASCOMP} list contains files used by the {\bf Aldor}
\cite{5} compiler. These files should probably be autoloaded.
<<environment>>=
@@ -406,11 +388,9 @@ be in the lisp image thus minimizing their startup time.
These files were in the interp distribution from NAG but have
no purpose at the moment. This belief is no doubt due to my
lack of understanding. Rather than erase them they are documented
-here for future reference. [[${DOC}/nag-e02a.boot.dvi]] and
-[[${DOC}/nag-e02b.boot.dvi]] appear to be two halfs of the file
-[[${DOC}/nag-e02.boot.dvi]] and have been removed.
+here for future reference.
<<environment>>=
-UNUSED= ${DOC}/anna.boot.dvi ${DOC}/construc.lisp.dvi \
+UNUSED= ${DOC}/construc.lisp.dvi \
${DOC}/domain.lisp.dvi ${DOC}/guess.boot.dvi \
${DOC}/interp-fix.boot.dvi \
${DOC}/nhyper.boot.dvi ${DOC}/pf2atree.boot.dvi \
@@ -438,7 +418,7 @@ makeint.lisp: ${OBJS} bookvol5.$(FASLEXT) util.$(FASLEXT) \
sys-driver.$(FASLEXT) \
${OUTINTERP} obey.$(FASLEXT) \
database.date ${INOBJS} ${ASCOMP} ${ASAUTO} \
- ${NAGBROBJS} ${TRANOBJS} \
+ ${TRANOBJS} \
${LOADSYS} \
$(axiom_targetdir)/algebra/exposed.$(FASLEXT) \
$(axiom_src_docdir)/msgs/s2-us.msgs \
@@ -458,7 +438,7 @@ makeint.lisp: ${OBJS} bookvol5.$(FASLEXT) util.$(FASLEXT) \
@ echo '(in-package "BOOT")' >> makeint.lisp
@ touch ${TIMESTAMP}
@ echo '${YEARWEEK}' >> makeint.lisp
- @ echo '(boot::build-interpsys (append (quote ($(interpsys_modules))) (quote ($(AS_modules))) (quote ($(IN_modules)))) (quote ($(patsubst %, "%", ${TRANOBJS}))) (quote ($(patsubst %, "%", ${NAGBROBJS}))) (quote ($(patsubst %, "%", ${ASAUTO}))))' >> makeint.lisp
+ @ echo '(boot::build-interpsys (append (quote ($(interpsys_modules))) (quote ($(AS_modules))) (quote ($(IN_modules)))) (quote ($(patsubst %, "%", ${TRANOBJS}))) (quote ($(patsubst %, "%", ${ASAUTO}))))' >> makeint.lisp
@ echo '(boot::set-restart-hook)' >> makeint.lisp
@ echo '(in-package "BOOT")' >> makeint.lisp
@ echo '(load "../algebra/warm.data")' >> makeint.lisp
@@ -612,54 +592,6 @@ distclean-local: clean-local
$(AUTO)/%.$(FASLEXT): %.$(FASLEXT)
$(INSTALL) $< $@
-## NAG Links and Friends
-
-nag-s.$(FASLEXT): nag-s.boot macros.$(FASLEXT)
- $(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $<
-
-nag-f07.$(FASLEXT): nag-f07.boot macros.$(FASLEXT)
- $(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $<
-
-nag-f04.$(FASLEXT): nag-f04.boot macros.$(FASLEXT)
- $(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $<
-
-nag-f02.$(FASLEXT): nag-f02.boot macros.$(FASLEXT)
- $(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $<
-
-nag-f01.$(FASLEXT): nag-f01.boot macros.$(FASLEXT)
- $(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $<
-
-nag-e04.$(FASLEXT): nag-e04.boot macros.$(FASLEXT)
- $(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $<
-
-nag-e02.$(FASLEXT): nag-e02.boot macros.$(FASLEXT)
- $(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $<
-
-nag-e02b.$(FASLEXT): nag-e02b.boot macros.$(FASLEXT)
- $(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $<
-
-nag-e01.$(FASLEXT): nag-e01.boot macros.$(FASLEXT)
- $(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $<
-
-nag-d03.$(FASLEXT): nag-d03.boot macros.$(FASLEXT)
- $(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $<
-
-nag-d02.$(FASLEXT): nag-d02.boot macros.$(FASLEXT)
- $(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $<
-
-nag-d01.$(FASLEXT): nag-d01.boot macros.$(FASLEXT)
- $(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $<
-
-nag-c06.$(FASLEXT): nag-c06.boot macros.$(FASLEXT)
- $(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $<
-
-nag-c05.$(FASLEXT): nag-c05.boot macros.$(FASLEXT)
- $(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $<
-
-nag-c02.$(FASLEXT): nag-c02.boot macros.$(FASLEXT)
- $(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $<
-
-
## Translation to Fortran
fortcall.$(FASLEXT): fortcall.boot sys-macros.$(FASLEXT)
$(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $<
diff --git a/src/interp/anna.boot b/src/interp/anna.boot
deleted file mode 100644
index 8d501810..00000000
--- a/src/interp/anna.boot
+++ /dev/null
@@ -1,1910 +0,0 @@
--- 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.
-
-
-annaGen command ==
- htInitPage('"AXIOM/NAG Expert System Command",nil)
- string :=
- #command < 50 => STRCONC('"{\centerline{\tt ",command,'" }}")
- STRCONC('"{\tt ",command,'" }")
- htMakePage [
- '(text
- "\center{{\em Here is the AXIOM command}}"
- "\center{{\em you could have issued to compute this result:}}"
- "\vspace{2}\newline "),
- ['text,: string]]
- htMakeDoitButton('"Do It", command)
- htShowPage()
-
-annaInt() ==
- htInitPage('"Integration using AXIOM/NAG Expert System",nil)
- htMakePage '(
- (domainConditions
- (isDomain F (Float))
- (isDomain PI (PositiveInteger))
- (isDomain EM $EmptyMode))
- (text . "\blankline ")
- (text . "Analyses the function for various attributes, chooses and ")
- (text . "then uses a suitable integration routine to ")
- (text . "evaluate the finite, semi-infinite or infinite integral ")
- (text . "\blankline ")
- (text . "\tab{22} \space{1} \vspace{-32} ")
- (text . "\inputbitmap{\htbmdir{}/ing.bitmap} \vspace{-34} f(x) dx ")
- (text . "\blankline ")
- (text . "\newline")
- (text . "\newline \menuitemstyle{} \tab{2} {\em Lower} bound of the interval {\em a}: ")
- (radioButtons lower
- ("" " Finite" lowerFinite)
- ("" " Minus Infinity" lowerInfinite))
- (text . "\blankline ")
- (text . "\newline \menuitemstyle{} \tab{2} {\em Upper} bound of the interval {\em b}: ")
- (radioButtons upper
- ("" " Finite" upperFinite)
- ("" " Plus Infinity" upperInfinite)))
- htMakeDoneButton('"Continue",'annaIntSolve)
- htShowPage()
-
-annaDan() ==
-
- page := htInitPage('"Integration using AXIOM/NAG Expert System",nil)
- htMakePage '(
- (domainConditions
- (isDomain F (Float))
- (isDomain PI (PositiveInteger))
- (isDomain EM $EmptyMode))
- (text . "\menuitemstyle{}\tab{2} ")
- (text . "Enter the {\em function} f to be integrated: \newline \tab{2} ")
- (bcStrings (50 "(log(2-x)*log(x))/((2-x)^(2/3)*sqrt(x))" expression EM))
- (text . "\blankline ")
- (text . "\newline \menuitemstyle{}\tab{2} ")
- (text . "\newline {\em Lower} bound of the interval {\em a}: ")
- (text . "\tab{30} \menuitemstyle{}\tab{32} ")
- (text . "{\em Upper} bound of the interval {\em b}:")
- (text . "\newline\tab{2} ")
- (bcStrings (15 "0.0" lower EM))
- (text . "\tab{32} ")
- (bcStrings (15 "2.0" upper EM))
- (text . "\blankline ")
- (text . "\newline ")
- (text . "\menuitemstyle{}\tab{2}")
- (text . "\newline Absolute accuracy required:")
- (text . "\tab{30} \menuitemstyle{}\tab{32}")
- (text . "Relative accuracy required:")
- (text . "\newline\tab{2} ")
- (bcStrings (10 "0.0" epsabs F))
- (text . "\tab{32} ")
- (bcStrings (10 "1.0e-6" epsrel F))
- (text . "\blankline"))
- htMakeDoneButton('"Continue",'annaIntGen)
- htShowPage()
-
-annaBar() ==
-
- page := htInitPage('"Integration using AXIOM/NAG Expert System",nil)
- htMakePage '(
- (domainConditions
- (isDomain F (Float))
- (isDomain PI (PositiveInteger))
- (isDomain EM $EmptyMode))
- (text . "\menuitemstyle{}\tab{2} ")
- (text . "Enter the {\em function} f to be integrated: \newline \tab{2} ")
- (bcStrings (50 "exp(-y)/sqrt(y)" expression EM))
- (text . "\blankline ")
- (text . "\newline \menuitemstyle{}\tab{2} ")
- (text . "\newline {\em Lower} bound of the interval {\em a}: ")
- (text . "\tab{30} \menuitemstyle{}\tab{32} ")
- (text . "{\em Upper} bound of the interval {\em b}:")
- (text . "\newline\tab{2} ")
- (bcStrings (15 "0.0" lower EM))
- (text . "\tab{32} ")
- (bcStrings (15 "%plusInfinity" upper EM))
- (text . "\blankline ")
- (text . "\newline ")
- (text . "\menuitemstyle{}\tab{2}")
- (text . "\newline Absolute accuracy required:")
- (text . "\tab{30} \menuitemstyle{}\tab{32}")
- (text . "Relative accuracy required:")
- (text . "\newline\tab{2} ")
- (bcStrings (10 "0.0" epsabs F))
- (text . "\tab{32} ")
- (bcStrings (10 "1.0e-6" epsrel F))
- (text . "\blankline"))
- htMakeDoneButton('"Continue",'annaIntGen)
- htShowPage()
-
-annaFoo() ==
-
- page := htInitPage('"Integration using AXIOM/NAG Expert System",nil)
- htMakePage '(
- (domainConditions
- (isDomain F (Float))
- (isDomain PI (PositiveInteger))
- (isDomain EM $EmptyMode))
- (text . "\menuitemstyle{}\tab{2} ")
- (text . "Enter the {\em function} f to be integrated: \newline \tab{2} ")
- (bcStrings (50 "(exp(-x^3)+exp(-3*x^2))/sqrt(x)" expression EM))
- (text . "\blankline ")
- (text . "\newline \menuitemstyle{}\tab{2} ")
- (text . "\newline {\em Lower} bound of the interval {\em a}: ")
- (text . "\tab{30} \menuitemstyle{}\tab{32} ")
- (text . "{\em Upper} bound of the interval {\em b}:")
- (text . "\newline\tab{2} ")
- (bcStrings (15 "0.0" lower EM))
- (text . "\tab{32} ")
- (bcStrings (15 "%plusInfinity" upper EM))
- (text . "\blankline ")
- (text . "\newline ")
- (text . "\newline ")
- (text . "\menuitemstyle{}\tab{2}")
- (text . "\newline Absolute accuracy required:")
- (text . "\tab{30} \menuitemstyle{}\tab{32}")
- (text . "Relative accuracy required:")
- (text . "\newline\tab{2} ")
- (bcStrings (10 "0.0" epsabs F))
- (text . "\tab{32} ")
- (bcStrings (10 "1.0e-6" epsrel F))
- (text . "\blankline"))
- htMakeDoneButton('"Continue",'annaIntGen)
- htShowPage()
-
-annaBlah() ==
-
- page := htInitPage('"Integration using AXIOM/NAG Expert System",nil)
- htMakePage '(
- (domainConditions
- (isDomain F (Float))
- (isDomain PI (PositiveInteger))
- (isDomain EM $EmptyMode))
- (text . "\menuitemstyle{}\tab{2} ")
- (text . "Enter the {\em function} f to be integrated: \newline \tab{2} ")
- (bcStrings (50 "exp(-omega)/((omega-5)*(omega-1/2))" expression EM))
- (text . "\blankline ")
- (text . "\newline \menuitemstyle{}\tab{2} ")
- (text . "\newline {\em Lower} bound of the interval {\em a}: ")
- (text . "\tab{30} \menuitemstyle{}\tab{32} ")
- (text . "{\em Upper} bound of the interval {\em b}:")
- (text . "\newline\tab{2} ")
- (bcStrings (15 "0.0" lower EM))
- (text . "\tab{32} ")
- (bcStrings (15 "%plusInfinity" upper EM))
- (text . "\blankline ")
- (text . "\newline ")
- (text . "\newline ")
- (text . "\menuitemstyle{}\tab{2}")
- (text . "\newline Absolute accuracy required:")
- (text . "\tab{30} \menuitemstyle{}\tab{32}")
- (text . "Relative accuracy required:")
- (text . "\newline\tab{2} ")
- (bcStrings (10 "0.0" epsabs F))
- (text . "\tab{32} ")
- (bcStrings (10 "1.0e-6" epsrel F))
- (text . "\blankline"))
- htMakeDoneButton('"Continue",'annaIntGen)
- htShowPage()
-
-annaJoe() ==
-
- page := htInitPage('"Integration using AXIOM/NAG Expert System",nil)
- htMakePage '(
- (domainConditions
- (isDomain F (Float))
- (isDomain PI (PositiveInteger))
- (isDomain EM $EmptyMode))
- (text . "\menuitemstyle{}\tab{2} ")
- (text . "Enter the {\em function} f to be integrated: \newline \tab{2} ")
- (bcStrings (50 "(exp(-x^3)+exp(-3*x^2))/(x^2-2)" expression EM))
- (text . "\blankline ")
- (text . "\newline \menuitemstyle{}\tab{2} ")
- (text . "\newline {\em Lower} bound of the interval {\em a}: ")
- (text . "\tab{30} \menuitemstyle{}\tab{32} ")
- (text . "{\em Upper} bound of the interval {\em b}:")
- (text . "\newline\tab{2} ")
- (bcStrings (15 "0.0" lower EM))
- (text . "\tab{32} ")
- (bcStrings (15 "2.0" upper EM))
- (text . "\blankline ")
- (text . "\newline ")
- (text . "\newline ")
- (text . "\menuitemstyle{}\tab{2}")
- (text . "\newline Absolute accuracy required:")
- (text . "\tab{30} \menuitemstyle{}\tab{32}")
- (text . "Relative accuracy required:")
- (text . "\newline\tab{2} ")
- (bcStrings (10 "0.0" epsabs F))
- (text . "\tab{32} ")
- (bcStrings (10 "1.0e-6" epsrel F))
- (text . "\blankline"))
- htMakeDoneButton('"Continue",'annaIntGen)
- htShowPage()
-
-annaSue() ==
-
- page := htInitPage('"Integration using AXIOM/NAG Expert System",nil)
- htMakePage '(
- (domainConditions
- (isDomain F (Float))
- (isDomain PI (PositiveInteger))
- (isDomain EM $EmptyMode))
- (text . "\menuitemstyle{}\tab{2} ")
- (text . "Enter the {\em function} f to be integrated: \newline \tab{2} ")
- (bcStrings (50 "1/(x^6-1)" expression EM))
- (text . "\blankline ")
- (text . "\newline \menuitemstyle{}\tab{2} ")
- (text . "\newline {\em Lower} bound of the interval {\em a}: ")
- (text . "\tab{30} \menuitemstyle{}\tab{32} ")
- (text . "{\em Upper} bound of the interval {\em b}:")
- (text . "\newline\tab{2} ")
- (bcStrings (15 "0.0" lower EM))
- (text . "\tab{32} ")
- (bcStrings (15 "2.0" upper EM))
- (text . "\blankline ")
- (text . "\newline ")
- (text . "\newline ")
- (text . "\menuitemstyle{}\tab{2}")
- (text . "\newline Absolute accuracy required:")
- (text . "\tab{30} \menuitemstyle{}\tab{32}")
- (text . "Relative accuracy required:")
- (text . "\newline\tab{2} ")
- (bcStrings (10 "0.0" epsabs F))
- (text . "\tab{32} ")
- (bcStrings (10 "1.0e-6" epsrel F))
- (text . "\blankline"))
- htMakeDoneButton('"Continue",'annaIntGen)
- htShowPage()
-
-annaAnn() ==
-
- page := htInitPage('"Integration using AXIOM/NAG Expert System",nil)
- htMakePage '(
- (domainConditions
- (isDomain F (Float))
- (isDomain PI (PositiveInteger))
- (isDomain EM $EmptyMode))
- (text . "\menuitemstyle{}\tab{2} ")
- (text . "Enter the {\em function} f to be integrated: \newline \tab{2} ")
- (bcStrings (50 "cos(t^2)+sin(t)+cos(sin(t^3))" expression EM))
- (text . "\blankline ")
- (text . "\newline \menuitemstyle{}\tab{2} ")
- (text . "\newline {\em Lower} bound of the interval {\em a}: ")
- (text . "\tab{30} \menuitemstyle{}\tab{32} ")
- (text . "{\em Upper} bound of the interval {\em b}:")
- (text . "\newline\tab{2} ")
- (bcStrings (15 "-%pi" lower EM))
- (text . "\tab{32} ")
- (bcStrings (15 "%pi" upper EM))
- (text . "\blankline ")
- (text . "\newline ")
- (text . "\newline ")
- (text . "\menuitemstyle{}\tab{2}")
- (text . "\newline Absolute accuracy required:")
- (text . "\tab{30} \menuitemstyle{}\tab{32}")
- (text . "Relative accuracy required:")
- (text . "\newline\tab{2} ")
- (bcStrings (10 "0.0" epsabs F))
- (text . "\tab{32} ")
- (bcStrings (10 "1.0e-6" epsrel F))
- (text . "\blankline"))
- htMakeDoneButton('"Continue",'annaIntGen)
- htShowPage()
-
-annaBab() ==
-
- page := htInitPage('"Integration using AXIOM/NAG Expert System",nil)
- htMakePage '(
- (domainConditions
- (isDomain F (Float))
- (isDomain PI (PositiveInteger))
- (isDomain EM $EmptyMode))
- (text . "\menuitemstyle{}\tab{2} ")
- (text . "Enter the {\em function} f to be integrated: \newline \tab{2} ")
- (bcStrings (50 "x*product(x-i/10,i=-4..4)" expression EM))
- (text . "\blankline ")
- (text . "\newline \menuitemstyle{}\tab{2} ")
- (text . "\newline {\em Lower} bound of the interval {\em a}: ")
- (text . "\tab{30} \menuitemstyle{}\tab{32} ")
- (text . "{\em Upper} bound of the interval {\em b}:")
- (text . "\newline\tab{2} ")
- (bcStrings (15 "-1" lower EM))
- (text . "\tab{32} ")
- (bcStrings (15 "1" upper EM))
- (text . "\blankline ")
- (text . "\newline ")
- (text . "\newline ")
- (text . "\menuitemstyle{}\tab{2}")
- (text . "\newline Absolute accuracy required:")
- (text . "\tab{30} \menuitemstyle{}\tab{32}")
- (text . "Relative accuracy required:")
- (text . "\newline\tab{2} ")
- (bcStrings (10 "0.0" epsabs F))
- (text . "\tab{32} ")
- (bcStrings (10 "1.0e-6" epsrel F))
- (text . "\blankline"))
- htMakeDoneButton('"Continue",'annaIntGen)
- htShowPage()
-
-annaFnar() ==
-
- page := htInitPage('"Integration using AXIOM/NAG Expert System",nil)
- htMakePage '(
- (domainConditions
- (isDomain F (Float))
- (isDomain PI (PositiveInteger))
- (isDomain EM $EmptyMode))
- (text . "\menuitemstyle{}\tab{2} ")
- (text . "Enter the {\em function} f to be integrated: \newline \tab{2} ")
- (bcStrings (50 "cos(20*rho)*(sin(rho^2) + cos(rho^2))" expression EM))
- (text . "\blankline ")
- (text . "\newline \menuitemstyle{}\tab{2} ")
- (text . "\newline {\em Lower} bound of the interval {\em a}: ")
- (text . "\tab{30} \menuitemstyle{}\tab{32} ")
- (text . "{\em Upper} bound of the interval {\em b}:")
- (text . "\newline\tab{2} ")
- (bcStrings (15 "0" lower EM))
- (text . "\tab{32} ")
- (bcStrings (15 "1" upper EM))
- (text . "\blankline ")
- (text . "\newline ")
- (text . "\newline ")
- (text . "\menuitemstyle{}\tab{2}")
- (text . "\newline Absolute accuracy required:")
- (text . "\tab{30} \menuitemstyle{}\tab{32}")
- (text . "Relative accuracy required:")
- (text . "\newline\tab{2} ")
- (bcStrings (10 "0.0" epsabs F))
- (text . "\tab{32} ")
- (bcStrings (10 "1.0e-6" epsrel F))
- (text . "\blankline"))
- htMakeDoneButton('"Continue",'annaIntGen)
- htShowPage()
-
-annaTub() ==
-
- page := htInitPage('"Integration using AXIOM/NAG Expert System",nil)
- htMakePage '(
- (domainConditions
- (isDomain F (Float))
- (isDomain PI (PositiveInteger))
- (isDomain EM $EmptyMode))
- (text . "\menuitemstyle{}\tab{2} ")
- (text . "Enter the {\em function} f to be integrated: \newline \tab{2} ")
- (bcStrings (50 "exp(-z^2/2)/sqrt(2*%pi)" expression EM))
- (text . "\blankline ")
- (text . "\newline \menuitemstyle{}\tab{2} ")
- (text . "\newline {\em Lower} bound of the interval {\em a}: ")
- (text . "\tab{30} \menuitemstyle{}\tab{32} ")
- (text . "{\em Upper} bound of the interval {\em b}:")
- (text . "\newline\tab{2} ")
- (bcStrings (15 "%minusInfinity" lower EM))
- (text . "\tab{32} ")
- (bcStrings (15 "%plusInfinity" upper EM))
- (text . "\blankline ")
- (text . "\menuitemstyle{}\tab{2}")
- (text . "\newline Absolute accuracy required:")
- (text . "\tab{30} \menuitemstyle{}\tab{32}")
- (text . "Relative accuracy required:")
- (text . "\newline\tab{2} ")
- (bcStrings (10 "0.0" epsabs F))
- (text . "\tab{32} ")
- (bcStrings (10 "1.0e-6" epsrel F))
- (text . "\blankline"))
- htMakeDoneButton('"Continue",'annaIntGen)
- htShowPage()
-
-annaRats() ==
-
- page := htInitPage('"Integration using AXIOM/NAG Expert System",nil)
- htMakePage '(
- (domainConditions
- (isDomain F (Float))
- (isDomain PI (PositiveInteger))
- (isDomain EM $EmptyMode))
- (text . "\menuitemstyle{}\tab{2} ")
- (text . "Enter the {\em function} f to be integrated: \newline \tab{2} ")
- (bcStrings (50 "log(u*u)" expression EM))
- (text . "\blankline ")
- (text . "\newline \menuitemstyle{}\tab{2} ")
- (text . "\newline {\em Lower} bound of the interval {\em a}: ")
- (text . "\tab{30} \menuitemstyle{}\tab{32} ")
- (text . "{\em Upper} bound of the interval {\em b}:")
- (text . "\newline\tab{2} ")
- (bcStrings (15 "-1" lower EM))
- (text . "\tab{32} ")
- (bcStrings (15 "1" upper EM))
- (text . "\blankline ")
- (text . "\menuitemstyle{}\tab{2}")
- (text . "\newline Absolute accuracy required:")
- (text . "\tab{30} \menuitemstyle{}\tab{32}")
- (text . "Relative accuracy required:")
- (text . "\newline\tab{2} ")
- (bcStrings (10 "0.0" epsabs F))
- (text . "\tab{32} ")
- (bcStrings (10 "1.0e-6" epsrel F))
- (text . "\blankline"))
- htMakeDoneButton('"Continue",'annaIntGen)
- htShowPage()
-
-annaIntSolve htPage ==
-
- l := htpButtonValue(htPage,'lower)
- u := htpButtonValue(htPage,'upper)
- a :=
- l = 'lowerFinite => '"finite"
- '"%minusInfinity"
- b :=
- u = 'upperFinite => '"finite"
- '"%plusInfinity"
- (a = b) => annaDan()
- a = '"finite" => annaFoo()
- b = '"%plusInfinity" => annaTub()
- page := htInitPage('"Integration using AXIOM/NAG Expert System",htPage)
- htMakePage '(
- (domainConditions
- (isDomain F (Float))
- (isDomain PI (PositiveInteger))
- (isDomain EM $EmptyMode))
- (text . "\menuitemstyle{}\tab{2} ")
- (text . "Enter the {\em function} f to be integrated: \newline \tab{2} ")
- (bcStrings (45 "exp(-x^2/2)/sqrt(2*%pi)" expression EM))
- (text . "\blankline ")
- (text . "\newline \menuitemstyle{}\tab{2} ")
- (text . "\newline {\em Lower} bound of the interval {\em a}: ")
- (text . "\tab{30} \menuitemstyle{}\tab{32} ")
- (text . "{\em Upper} bound of the interval {\em b}:")
- (text . "\newline\tab{2} ")
- (bcStrings (15 "%minusInfinity" lower EM))
- (text . "\tab{32} ")
- (bcStrings (15 "0.0" upper EM))
- (text . "\blankline ")
- (text . "\newline ")
- (text . "\menuitemstyle{}\tab{2}")
- (text . "\newline Absolute accuracy required:")
- (text . "\tab{30} \menuitemstyle{}\tab{32}")
- (text . "Relative accuracy required:")
- (text . "\newline\tab{2} ")
- (bcStrings (10 "0.0" epsabs F))
- (text . "\tab{32} ")
- (bcStrings (10 "1.0e-6" epsrel F))
- (text . "\blankline"))
- htMakeDoneButton('"Continue",'annaIntGen)
- htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
- htShowPage()
-
-
-annaIntGen htPage ==
- lower := htpLabelInputString(htPage,'lower)
- upper := htpLabelInputString(htPage,'upper)
- expression := htpLabelInputString(htPage,'expression)
- epsabs := htpLabelInputString(htPage,'epsabs)
- epsrel := htpLabelInputString(htPage,'epsrel)
- annaGen STRCONC('"integrate(",expression,", ",lower,"..",upper,", ",epsabs,", ",epsrel,")")
-
-annaMInt() ==
- htInitPage('"Integration using AXIOM/NAG Expert System",nil)
- htMakePage '(
- (domainConditions
- (isDomain PI (PositiveInteger))
- (isDomain EM $EmptyMode))
- (text . "Analyses the function for various attributes, chooses and ")
- (text . "then uses a suitable integration routine ")
- (text . "\blankline ")
- (text . "\menuitemstyle{}\tab{2} ")
- (text . "Enter the {\em function} f of the form: ")
- (text . "\center{\inputbitmap{\htbmdir{}/d01fcf.bitmap}} ")
- (text . "\newline ")
- (text . "to be integrated in terms of subscripted ")
- (text . "variables e.g. X[1]...X[n]: \newline \tab{2} ")
- (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 . "\menuitemstyle{}\tab{2} ")
- (text . "Number of dimensions n in the integral, 2 \htbitmap{less=} ")
- (text . "{\it N} \htbitmap{less=} 15: ")
- (text . "\newline\tab{2} ")
- (bcStrings (2 4 n PI))
- (text . "\blankline ")
- (text . "\blankline "))
- htMakeDoneButton('"Continue", 'annaMIntSolve)
- htShowPage()
-
-annaMIntSolve htPage ==
- n :=
- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
- objValUnwrap htpLabelSpadValue(htPage, 'n)
- n = '4 => annaMIntDefaultSolve(htPage)
- expression := htpLabelInputString(htPage,'expression)
- rangeList :=
- "append"/[f(i,n) for i in 1..n] where f(i,n) ==
- prefix := ('"\newline a")
- prefix := STRCONC(prefix,STRINGIMAGE i,'"\space{1}")
- post := ('"\tab{30} b")
- post := STRCONC(post,STRINGIMAGE i,'"\space{1}")
- rnam := INTERN STRCONC ('"x",STRINGIMAGE i)
- inam := INTERN STRCONC ('"y",STRINGIMAGE i)
- [['text,:prefix],['bcStrings,[5, 0.0, rnam, 'EM]],
- ['text,:post],['bcStrings,[5, 1.0, inam, 'EM]]]
- errList :=
- errtext := ('"\newline \blankline \menuitemstyle{}\tab{2}")
- errtext := STRCONC(errtext,'"Absolute accuracy required:")
- errtext := STRCONC(errtext,'"\tab{30} \menuitemstyle{}\tab{32}")
- errtext := STRCONC(errtext,'"Relative accuracy required: \newline\tab{2} ")
- [['text,:errtext],['bcStrings,[10, 0.0, 'abserr, 'F]],
- ['text,"\tab{32} "],['bcStrings,[10, 1.0e-4, 'relerr, 'F]]]
- equationPart := [
- '(domainConditions
- (isDomain EM ($EmptyMode))
- (isDomain F (Float))
- (isDomain S (String))
- (isDomain PI (PositiveInteger))),
- :rangeList,:errList]
- page := htInitPage("AXIOM/NAG Multiple Integration", htpPropertyList htPage)
- htSay '"Please enter the limits of integration:- "
- htSay '"\blankline \menuitemstyle{} \tab{2} "
- htSay '"Lower Limits: \tab{30} \menuitemstyle{} \tab{32} "
- htSay '"Upper Limits: \newline "
- htMakePage equationPart
- htMakeDoneButton('"Continue",'annaMIntGen)
- htpSetProperty(page,'expression,expression)
- htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
- htShowPage()
-
-annaMIntDefaultSolve (htPage) ==
-
- page := htInitPage('"AXIOM/NAG Multiple Integration",nil)
- expression := htpLabelInputString(htPage,'expression)
- htMakePage '(
- (domainConditions
- (isDomain F (Float))
- (isDomain EM $EmptyMode))
- (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 a1 ")
- (bcStrings (10 "0.0" a1 F))
- (text . "\tab{30} b1 ")
- (bcStrings (10 "1.0" b1 F))
- (text . "\newline a2 ")
- (bcStrings (10 "0.0" a2 F))
- (text . "\tab{30} b2 ")
- (bcStrings (10 "1.0" b2 F))
- (text . "\newline a3 ")
- (bcStrings (10 "0.0" a3 F))
- (text . "\tab{30} b3 ")
- (bcStrings (10 "1.0" b3 F))
- (text . "\newline a4 ")
- (bcStrings (10 "0.0" a4 F))
- (text . "\tab{30} b4 ")
- (bcStrings (10 "1.0" b4 F))
- (text . "\newline ")
- (text . "\blankline ")
- (text . "\menuitemstyle{}\tab{2}")
- (text . "\newline Absolute accuracy required:")
- (text . "\tab{30} \menuitemstyle{}\tab{32}")
- (text . "Relative accuracy required:")
- (text . "\newline\tab{2} ")
- (bcStrings (10 "0.0" epsabs F))
- (text . "\tab{32} ")
- (bcStrings (10 "1.0e-4" epsrel F))
- (text . "\blankline"))
- htMakeDoneButton('"Continue",'annaMIntGen)
- htpSetProperty(page,'expression,expression)
- htpSetProperty(page,'inputArea, htpInputAreaAlist htPage)
- htShowPage()
-
-
-annaMIntGen htPage ==
- expression := htpProperty(htPage,'expression)
- alist := htpInputAreaAlist htPage
- y := alist
- epsrel := STRCONC((first y).1,'"")
- y := rest y
- epsabs := STRCONC((first y).1,'"")
- y := rest y
- while y repeat
- right := STRCONC((first y).1,'"")
- y := rest y
- left := STRCONC((first y).1,"..")
- y := rest y
- rangelist := [STRCONC(left,right),:rangelist]
- rangestring := bcwords2liststring rangelist
- annaGen STRCONC ('"integrate( ",expression,", ",rangestring,", ",epsabs,", ",epsrel,")")
-
-annaOde() ==
- htInitPage('"Solution of Initial Value Problems of Ordinary Differential Equations using AXIOM/NAG Expert System",nil)
- htMakePage '(
- (domainConditions
- (isDomain F (Float))
- (isDomain PI (PositiveInteger))
- (isDomain EM $EmptyMode))
- (text . "Analyses the function for various attributes, chooses and ")
- (text . "then uses a suitable ODE solver to provide a ")
- (text . "solution to the system of n ODEs \center{\htbitmap{d02gaf},}" )
- (text . "for i = 1,2,...,n.")
- (text . "\blankline ")
- (text . "\newline \menuitemstyle{} \tab{2} Is there any stopping criteria (i.e. some function ")
- (text . "G(X,Y) such that the algorithm should stop when G(X,Y) = 0)? ")
- (radioButtons stoppingCriteria
- ("" " No \space{1} If No, G(X,Y) is set to 1.0" nostop)
- ("" " Yes" stop))
- (text . "\blankline")
- (text . "\newline \menuitemstyle{} \tab{2} Are intermediate values required? ")
- (radioButtons intermediateValues
- ("" " No" noint)
- ("" " Yes" int))
- (text . "\blankline ")
- (text . "\menuitemstyle{}\tab{2} ")
- (text . "\newline Size of the system of equations:\space{1}")
- (bcStrings (3 3 n PI))
- (text . "\newline"))
- htMakeDoneButton('"Continue",'annaOdeSolve)
- htShowPage()
-
-annaOdeSolve htPage ==
-
- s := htpButtonValue(htPage,'stoppingCriteria)
- i := htpButtonValue(htPage,'intermediateValues)
- stoppingCriteria :=
- s = 'nostop => '"no"
- '"stopping"
- intermediateValues :=
- i = 'noint => '"no"
- '"intervals"
- n :=
- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
- objValUnwrap htpLabelSpadValue(htPage, 'n)
- (n = '3) =>
- (stoppingCriteria = intermediateValues) => annaOdeDefaultSolve()
- (stoppingCriteria = '"stopping") =>
- (intermediateValues = '"intervals") => annaOdeDefaultSolve1()
- annaOdeDefaultSolve2()
- annaOdeDefaultSolve3()
- expressionList :=
- "append"/[fe(i,n) for i in 1..n] where fe(i,n) ==
- prefix := ('"\blankline \newline Y")
- prefix := STRCONC(prefix,STRINGIMAGE i,'"'\space{1}")
- expression := INTERN STRCONC ('"Y",STRINGIMAGE i)
- [['text,:prefix],
- ['bcStrings,[45, STRCONC ('"Y[",STRINGIMAGE i,'"]"), expression, 'EM]]]
- xList :=
- prefix := ('"\blankline \newline \menuitemstyle{} \tab{2} Initial Value for X: ")
- middle := ('"\tab{24} \menuitemstyle{} \tab{26} Final Value for X: ")
- [['text,:prefix],['bcStrings,[5, "0.0", "xinit", 'EM]],
- ['text,:middle],['bcStrings,[5, "10.0", "xend", 'EM]]]
- middle := ('"\blankline \menuitemstyle{} \tab{2} Initial Value for Y[i]: ")
- middle := STRCONC(middle,"\newline ")
- yinitList :=
- "append"/[fy(i,n) for i in 1..n] where fy(i,n) ==
- prefix := ('"\newline Y")
- prefix := STRCONC(prefix,STRINGIMAGE i,'"\space{1}")
- yinit := INTERN STRCONC ('"y",STRINGIMAGE i)
- [['text,:prefix],['bcStrings,[10, '"0.0", yinit, 'EM]]]
- yinitList := [['text,:middle],:yinitList]
- if stoppingCriteria = '"no" then
- sExpression := []
- else
- sText := '"\blankline \newline \menuitemstyle{} \tab{2}"
- sText := STRCONC(sText,'"\newline Enter the function G(x,y) (The Stopping Criteria): ")
- sText := STRCONC(sText,'"\newline \tab{2}")
- sExpression := [['bcStrings,[15, '"Y[1]", "stop", 'EM]]]
- sExpression := [['text,sText],:sExpression]
- if intermediateValues = '"no" then
- ilist := []
- else
- iText := '"\blankline \newline \menuitemstyle{} \tab{2}"
- iText := STRCONC(iText,'"Enter the list of Intermediate Values required: ")
- iText := STRCONC(iText,"\newline \tab{2}")
- iList := [['bcStrings,[15, '"[2,4,6,8]", "ivals", 'EM]]]
- iList := [['text,iText],:iList]
- tolList :=
- tolText := '"\blankline \newline \menuitemstyle{} \tab{2}"
- tolText := STRCONC(tolText,'"Relative accuracy required:\space{1}")
- [['text,tolText],['bcStrings,[10, '"1.0e-4", "relerr", 'F]]]
- expressionPart := [
- '(domainConditions
- (isDomain EM ($EmptyMode))
- (isDomain F (Float))
- (isDomain S (String))
- (isDomain PI (PositiveInteger))),
- :expressionList,:xList,:yinitList,:sExpression,:iList,:tolList]
- page := htInitPage("AXIOM/NAG ODE Solvers", htpPropertyList htPage)
- htSay '"\menuitemstyle{} \tab{2} Enter the list of ODE's (i.e.~the derivatives "
- htSay '"Y[1]'..Y[n]') in terms of Y[1]..Y[n]: "
- htSay '"\newline "
- htMakePage expressionPart
- htMakeDoneButton('"Continue",'annaOdeGen)
- htpSetProperty(page,'n,n)
- htpSetProperty(page,'stoppingCriteria,stoppingCriteria)
- htpSetProperty(page,'intermediateValues,intermediateValues)
- htShowPage()
-
-
-annaOdeDefaultSolve() ==
-
- n := '3
- stoppingCriteria := '"no"
- intermediateValues := '"no"
- page := htInitPage('"Solution of Initial Value Problems of Ordinary Differential Equations using AXIOM/NAG Expert System",nil)
- htMakePage '(
- (domainConditions
- (isDomain F (Float))
- (isDomain PI (PositiveInteger))
- (isDomain EM $EmptyMode))
- (text . "\menuitemstyle{} \tab{2} Enter the list of ODE's (i.e. the derivatives Y[1]'..Y[n]') ")
- (text . "in terms of Y[1]..Y[n]: ")
- (text . "\blankline ")
- (text . "\newline \tab{2} {\em Y[1]':} \space{1}")
- (bcStrings (42 "tan(Y[3])" Y1 EM))
- (text . "\blankline ")
- (text . "\newline \tab{2} {\em Y[2]':} \space{1}")
- (bcStrings (42 "-0.032*tan(Y[3])/Y[2]-0.02*Y[2]/cos(Y[3])" Y2 EM))
- (text . "\blankline ")
- (text . "\newline \tab{2} {\em Y[3]':} \space{1}")
- (bcStrings (42 "-0.032/(Y[2]**2)" Y3 EM))
- (text . "\blankline ")
- (text . "\newline \menuitemstyle{}\tab{2} ")
- (text . "\newline Initial Value for X: ")
- (text . "\tab{24} \menuitemstyle{}\tab{26} ")
- (text . "Final Value for X:")
- (text . "\newline\tab{2} ")
- (bcStrings (10 "0.0" xinit EM))
- (text . "\tab{26} ")
- (bcStrings (10 "10.0" xend EM))
- (text . "\blankline ")
- (text . "\newline \menuitemstyle{}\tab{2} ")
- (text . "\newline Initial Value for Y[i]: ")
- (text . "\newline \tab{2} {\em Y[1]:} \space{1}")
- (bcStrings (10 "0.5" y1 EM))
- (text . "\newline \tab{2} {\em Y[2]:} \space{1}")
- (bcStrings (10 "0.5" y2 EM))
- (text . "\newline \tab{2} {\em Y[3]:} \space{1}")
- (bcStrings (10 "%pi*0.2" y3 EM))
- (text . "\blankline ")
- (text . "\newline \menuitemstyle{}\tab{2} ")
- (text . "Relative accuracy required:\space{1}")
- (bcStrings (10 "1.0e-4" tol F))
- (text . "\blankline "))
- htMakeDoneButton('"Continue",'annaOdeGen)
- htpSetProperty(page,'stoppingCriteria,stoppingCriteria)
- htpSetProperty(page,'intermediateValues,intermediateValues)
- htpSetProperty(page,'n,n)
- htShowPage()
-
-annaOdeDefaultSolve3() ==
-
- n := '3
- stoppingCriteria := '"no"
- intermediateValues := '"intervals"
- page := htInitPage('"Solution of Initial Value Problems of Ordinary Differential Equations using AXIOM/NAG Expert System",nil)
- htMakePage '(
- (domainConditions
- (isDomain F (Float))
- (isDomain PI (PositiveInteger))
- (isDomain EM $EmptyMode))
- (text . "\menuitemstyle{} \tab{2} Enter the list of ODE's (i.e. the derivatives Y[1]'..Y[n]') ")
- (text . "in terms of Y[1]..Y[n]: ")
- (text . "\blankline ")
- (text . "\newline \tab{2} {\em Y[1]':} \space{1}")
- (bcStrings (42 "-0.04*Y[1]+1.0e4*Y[2]*Y[3]" Y1 EM))
- (text . "\blankline ")
- (text . "\newline \tab{2} {\em Y[2]':} \space{1}")
- (bcStrings (42 "0.04*Y[1]-1.0e4*Y[2]*Y[3]-3.0e7*Y[2]*Y[2]" Y2 EM))
- (text . "\blankline ")
- (text . "\newline \tab{2} {\em Y[3]':} \space{1}")
- (bcStrings (42 "3.0e7*Y[2]*Y[2]" Y3 EM))
- (text . "\blankline ")
- (text . "\newline \menuitemstyle{}\tab{2} ")
- (text . "\newline Initial Value for X: ")
- (text . "\tab{24} \menuitemstyle{}\tab{26} ")
- (text . "Final Value for X:")
- (text . "\newline\tab{2} ")
- (bcStrings (10 "0.0" xinit EM))
- (text . "\tab{26} ")
- (bcStrings (10 "10.0" xend EM))
- (text . "\blankline ")
- (text . "\newline \menuitemstyle{}\tab{2} ")
- (text . "\newline Initial Value for Y[i]: ")
- (text . "\newline \tab{2} {\em Y[1]:} \space{1}")
- (bcStrings (10 "1.0" y1 EM))
- (text . "\newline \tab{2} {\em Y[2]:} \space{1}")
- (bcStrings (10 "0.0" y2 EM))
- (text . "\newline \tab{2} {\em Y[3]:} \space{1}")
- (bcStrings (10 "0.0" y3 EM))
- (text . "\blankline ")
- (text . "\newline \menuitemstyle{}\tab{2} ")
- (text . "\newline Enter the list of Intermediate Values required: ")
- (bcStrings (10 "[2,4,6,8]" intvals EM))
- (text . "\blankline ")
- (text . "\newline \menuitemstyle{}\tab{2} ")
- (text . "Relative accuracy required:\space{1}")
- (bcStrings (10 "1.0e-4" tol F))
- (text . "\blankline "))
- htMakeDoneButton('"Continue",'annaOdeGen)
- htpSetProperty(page,'stoppingCriteria,stoppingCriteria)
- htpSetProperty(page,'intermediateValues,intermediateValues)
- htpSetProperty(page,'n,n)
- htShowPage()
-
-annaOdeDefaultSolve2() ==
-
- n := '3
- stoppingCriteria := '"stopping"
- intermediateValues := '"no"
- page := htInitPage('"Solution of Initial Value Problems of Ordinary Differential Equations using AXIOM/NAG Expert System",nil)
- htMakePage '(
- (domainConditions
- (isDomain F (Float))
- (isDomain PI (PositiveInteger))
- (isDomain EM $EmptyMode))
- (text . "\menuitemstyle{} \tab{2} Enter the list of ODE's (i.e. the derivatives Y[1]'..Y[n]') ")
- (text . "in terms of Y[1]..Y[n]: ")
- (text . "\blankline ")
- (text . "\newline \tab{2} {\em Y[1]':} \space{1}")
- (bcStrings (42 "tan(Y[3])" Y1 EM))
- (text . "\blankline ")
- (text . "\newline \tab{2} {\em Y[2]':} \space{1}")
- (bcStrings (42 "-0.032*tan(Y[3])/Y[2]-0.02*Y[2]/cos(Y[3])" Y2 EM))
- (text . "\blankline ")
- (text . "\newline \tab{2} {\em Y[3]':} \space{1}")
- (bcStrings (42 "-0.032/(Y[2]**2)" Y3 EM))
- (text . "\blankline ")
- (text . "\newline \menuitemstyle{}\tab{2} ")
- (text . "\newline Initial Value for X: ")
- (text . "\tab{24} \menuitemstyle{}\tab{26} ")
- (text . "Final Value for X:")
- (text . "\newline\tab{2} ")
- (bcStrings (10 "0.0" xinit EM))
- (text . "\tab{26} ")
- (bcStrings (10 "10.0" xend EM))
- (text . "\blankline ")
- (text . "\newline \menuitemstyle{}\tab{2} ")
- (text . "\newline Initial Value for Y[i]: ")
- (text . "\newline \tab{2} {\em Y[1]:} \space{1}")
- (bcStrings (10 "0.5" y1 EM))
- (text . "\newline \tab{2} {\em Y[2]:} \space{1}")
- (bcStrings (10 "0.5" y2 EM))
- (text . "\newline \tab{2} {\em Y[3]:} \space{1}")
- (bcStrings (10 "%pi*0.2" y3 EM))
- (text . "\blankline ")
- (text . "\newline \menuitemstyle{}\tab{2} ")
- (text . "\newline Enter the function G(x,y) (The Stopping Criteria): ")
- (bcStrings (10 "Y[1]" g EM))
- (text . "\blankline ")
- (text . "\newline \menuitemstyle{}\tab{2} ")
- (text . "Relative accuracy required:\space{1}")
- (bcStrings (10 "1.0e-4" tol F))
- (text . "\blankline "))
- htMakeDoneButton('"Continue",'annaOdeGen)
- htpSetProperty(page,'stoppingCriteria,stoppingCriteria)
- htpSetProperty(page,'intermediateValues,intermediateValues)
- htpSetProperty(page,'n,n)
- htShowPage()
-
-annaOdeDefaultSolve1() ==
-
- n := '3
- stoppingCriteria := '"stopping"
- intermediateValues := '"intervals"
- page := htInitPage('"Solution of Initial Value Problems of Ordinary Differential Equations using AXIOM/NAG Expert System",nil)
- htMakePage '(
- (domainConditions
- (isDomain F (Float))
- (isDomain PI (PositiveInteger))
- (isDomain EM $EmptyMode))
- (text . "\menuitemstyle{} \tab{2} Enter the list of ODE's (i.e. the derivatives Y[1]'..Y[n]') ")
- (text . "in terms of Y[1]..Y[n]: ")
- (text . "\blankline ")
- (text . "\newline \tab{2} {\em Y[1]':} \space{1}")
- (bcStrings (42 "-0.04*Y[1]+1.0e4*Y[2]*Y[3]" Y1 EM))
- (text . "\blankline ")
- (text . "\newline \tab{2} {\em Y[2]':} \space{1}")
- (bcStrings (42 "0.04*Y[1]-1.0e4*Y[2]*Y[3]-3.0e7*Y[2]*Y[2]" Y2 EM))
- (text . "\blankline ")
- (text . "\newline \tab{2} {\em Y[3]':} \space{1}")
- (bcStrings (42 "3.0e7*Y[2]*Y[2]" Y3 EM))
- (text . "\blankline ")
- (text . "\newline \menuitemstyle{}\tab{2} ")
- (text . "\newline Initial Value for X: ")
- (text . "\tab{24} \menuitemstyle{}\tab{26} ")
- (text . "Final Value for X:")
- (text . "\newline\tab{2} ")
- (bcStrings (10 "0.0" xinit EM))
- (text . "\tab{26} ")
- (bcStrings (10 "10.0" xend EM))
- (text . "\blankline ")
- (text . "\newline \menuitemstyle{}\tab{2} ")
- (text . "\newline Initial Value for Y[i]: ")
- (text . "\newline \tab{2} {\em Y[1]:} \space{1}")
- (bcStrings (10 "1.0" y1 EM))
- (text . "\newline \tab{2} {\em Y[2]:} \space{1}")
- (bcStrings (10 "0.0" y2 EM))
- (text . "\newline \tab{2} {\em Y[3]:} \space{1}")
- (bcStrings (10 "0.0" y3 EM))
- (text . "\blankline ")
- (text . "\newline \menuitemstyle{}\tab{2} ")
- (text . "\newline Enter the function G(x,y) (The Stopping Criteria): ")
- (bcStrings (10 "Y[1]-0.9" g EM))
- (text . "\blankline ")
- (text . "\newline \menuitemstyle{}\tab{2} ")
- (text . "\newline Enter the list of Intermediate Values required: ")
- (bcStrings (10 "[2,4,6,8]" intvals EM))
- (text . "\blankline ")
- (text . "\newline \menuitemstyle{}\tab{2} ")
- (text . "Relative accuracy required:\space{1}")
- (bcStrings (10 "1.0e-4" tol F))
- (text . "\blankline "))
- htMakeDoneButton('"Continue",'annaOdeGen)
- htpSetProperty(page,'stoppingCriteria,stoppingCriteria)
- htpSetProperty(page,'intermediateValues,intermediateValues)
- htpSetProperty(page,'n,n)
- htShowPage()
-
-annaOdeGen htPage ==
-
- n := htpProperty(htPage,'n)
- stoppingCriteria := htpProperty(htPage,'stoppingCriteria)
- intermediateValues := htpProperty(htPage,'intermediateValues)
- alist := htpInputAreaAlist htPage
- y := alist
- epsrel := STRCONC((first y).1,'"")
- epsrelString := STRCONC(", ",epsrel)
- y := rest y
- if intermediateValues = '"no" then
- intvalsString := '""
- else
- intvals := STRCONC((first y).1,'"")
- intvalsString := STRCONC(", ",intvals)
- y := rest y
- if stoppingCriteria = '"no" then
- gString := '""
- else
- g := STRCONC((first y).1,'"")
- gString := STRCONC(", ",g)
- y := rest y
- for i in 1..n repeat
- yi := STRCONC((first y).1,'"")
- yiList := [yi,:yiList]
- y := rest y
- yiString := bcwords2liststring yiList
- xend := STRCONC((first y).1,'"")
- y := rest y
- xinit := STRCONC((first y).1,'"")
- y := rest y
- for i in 1..n repeat
- fi := STRCONC((first y).1,'"")
- fiList := [fi,:fiList]
- y := rest y
- fiString := bcwords2liststring fiList
- prefix := STRCONC('"solve(",fiString,", ", xinit,", ", xend,", ")
- prefix := STRCONC(prefix,yiString,gString,intvalsString,epsrelString)
- prefix := STRCONC(prefix,")")
- annaGen prefix
-
---d03fafVariables() ==
--- htInitPage('"Helmholtz Equation in 3-D, Cartesian Coordinates",nil)
--- htMakePage '(
--- (domainConditions
--- (isDomain F (Float))
--- (isDomain S (String)))
--- (text . "Descretizing the PDE:")
--- (text . "\newline\centerline{\inputbitmap{\htbmdir{}/d03faf.xbm}}")
--- (text . "\newline and solving the resulting seven-diagonal finite ")
--- (text . "difference equations using a method based on the Fast ")
--- (text . "Fourier Transform.\blankline Entering the names of pre-prepared ")
--- (text . "variables for xCond, yCond, zCond and f(x,y,z)")
--- (text . "\blankline Please enter the names of the condition variables")
--- (text . "\blankline \menuitemstyle{}\tab{2} xCond:\space{1} ")
--- (bcStrings (10 "xCond" x S))
--- (text . "\newline \menuitemstyle{}\tab{2} yCond:\space{1} ")
--- (bcStrings (10 "yCond" y S))
--- (text . "\newline \menuitemstyle{}\tab{2} zCond:\space{1} ")
--- (bcStrings (10 "zCond" z S))
--- (text . "\blankline \menuitemstyle{}\tab{2} Please enter the value of lambda:\space{1} ")
--- (bcStrings (8 "-1.0" lambda F))
--- (text . "\blankline \menuitemstyle{}\tab{2} Please enter the name of the variable for f(x,y,z):")
--- (text . "\space{1} ")
--- (bcStrings (10 "foo" f S))
--- (text . "\blankline "))
--- htMakeDoneButton('"Continue",'annaOptSolve)
--- htShowPage()
-
-annaPDESolve() ==
- htInitPage('"Second Order Elliptic Partial Differential Equation",nil)
- htMakePage '(
- (domainConditions
- (isDomain F (Float))
- (isDomain S (String))
- (isDomain EM $EmptyMode))
- (text . "Descretizing the PDE:")
- (text . "\newline\centerline{\inputbitmap{\htbmdir{}/d03eef.xbm}}")
- (text . "\newline defined on a rectangular region with boundary conditions of the form ")
- (text . "\centerline{\inputbitmap{\htbmdir{}/d03eef1.bitmap}} ")
- (text . " and solving the resulting seven-diagonal finite ")
- (text . "difference equations using a multigrid technique. \blankline ")
- (text . "\menuitemstyle{} \tab{2} Enter the rectangle on which to discretize the PDE : \newline ")
- (text . "\tab{11} Start \tab{20} Number of grid lines \tab{41} End ")
- (text . " \newline \tab{6} X : \space{1} " )
- (bcStrings(7 "0.0" xmin F))
- (text . "\space{7} ")
- (bcStrings(3 "9" ngx I))
- (text . "\space{7} ")
- (bcStrings(7 "1.0" xmax F))
- (text . "\newline \tab{6} Y : \space{1} " )
- (bcStrings(7 "0.0" ymin F))
- (text . "\space{7} ")
- (bcStrings(3 "9" ngy I))
- (text . "\space{7} ")
- (bcStrings(7 "1.0" ymax F))
- (text . "\blankline \menuitemstyle{} Enter the values of the expressions\space{1}")
- (text . " \inputbitmap{\htbmdir{}/alpha.xbm}(X,Y) to\space{1}")
- (text . " \inputbitmap{\htbmdir{}/psi.xbm}(X,Y) : ")
- (text . "\blankline \tab{3} \inputbitmap{\htbmdir{}/alpha.xbm}(X,Y) : ")
- (bcStrings (36 "1" alpha EM))
- (text . "\newline \tab{3} \inputbitmap{\htbmdir{}/beta.xbm}(X,Y) : ")
- (bcStrings (36 "0" beta EM))
- (text . "\newline \tab{3} \inputbitmap{\htbmdir{}/gamma.xbm}(X,Y) : ")
- (bcStrings (36 "1" gamma EM))
- (text . "\newline \tab{3} \inputbitmap{\htbmdir{}/delta.xbm}(X,Y) : ")
- (bcStrings (36 "50" delta EM))
- (text . "\newline \tab{3} \inputbitmap{\htbmdir{}/epsilon.xbm}(X,Y) : ")
- (bcStrings (36 "50" epsilon EM))
- (text . "\newline \tab{3} \inputbitmap{\htbmdir{}/phi.xbm}(X,Y) : ")
- (bcStrings (36 "0" phi EM))
- (text . "\newline \tab{3} \inputbitmap{\htbmdir{}/psi.xbm}(X,Y) : ")
- (bcStrings (36 "-2*sin(X)*sin(Y) + 50*cos(X)*sin(Y) + 50*sin(X)*cos(Y)" psi EM))
- (text . "\blankline \menuitemstyle{} Enter the values of the boundary ")
- (text . " condition expressions for the bottom, top, left and right sides : ")
- (text . " \blankline \tab{2} \menuitemstyle{} Bottom boundary conditions :")
- (text . " (Y := \inputbitmap{\htbmdir{}/ys.xbm})")
- (text . "\newline \tab{4} a(X,Y) : ")
- (bcStrings (34 "0" ba EM))
- (text . "\newline \tab{4} b(X,Y) : ")
- (bcStrings (34 "1" bb EM))
- (text . "\newline \tab{4} c(X,Y) : ")
- (bcStrings (34 "-sin(X)" bc EM))
- (text . " \blankline \tab{2} \menuitemstyle{} Top boundary conditions :")
- (text . " (Y := \inputbitmap{\htbmdir{}/ye.xbm})")
- (text . "\newline \tab{4} a(X,Y) : ")
- (bcStrings (34 "1" ta EM))
- (text . "\newline \tab{4} b(X,Y) : ")
- (bcStrings (34 "0" tb EM))
- (text . "\newline \tab{4} c(X,Y) : ")
- (bcStrings (34 "sin(X)*sin(Y)" tc EM))
- (text . " \blankline \tab{2} \menuitemstyle{} Left boundary conditions :")
- (text . " (X := \inputbitmap{\htbmdir{}/xs.xbm})")
- (text . "\newline \tab{4} a(X,Y) : ")
- (bcStrings (34 "0" la EM))
- (text . "\newline \tab{4} b(X,Y) : ")
- (bcStrings (34 "1" lb EM))
- (text . "\newline \tab{4} c(X,Y) : ")
- (bcStrings (34 "-sin(Y)" lc EM))
- (text . " \blankline \tab{2} \menuitemstyle{} Right boundary conditions :")
- (text . " (Y := \inputbitmap{\htbmdir{}/xe.xbm})")
- (text . "\newline \tab{4} a(X,Y) : ")
- (bcStrings (34 "1" ra EM))
- (text . "\newline \tab{4} b(X,Y) : ")
- (bcStrings (34 "0" rb EM))
- (text . "\newline \tab{4} c(X,Y) : ")
- (bcStrings (34 "sin(X)*sin(Y)" rc EM))
- (text . "\blankline \menuitemstyle{} Do you know that the PDE described is elliptic? \space{2}")
- (text . "\newline \tab{6} ")
- (bcRadioButtons ell
- ("" " Yes \space{2} " yes)
- ("" " Unknown" no))
- (text . "\blankline \menuitemstyle{} Required Tolerance : ")
- (bcStrings (10 "1.0e-4" tol F))
- (text . " \newline "))
- htMakeDoneButton('"Continue",'annaPDESolve2)
- htShowPage()
-
-annaPDESolve2 htPage ==
- e := htpButtonValue(htPage,'ell)
- ell :=
- e = 'yes => '"elliptic"
- '"unknown"
- xmin := htpLabelInputString(htPage,'xmin)
- ngx := htpLabelInputString(htPage,'ngx)
- xmax := htpLabelInputString(htPage,'xmax)
- ymin := htpLabelInputString(htPage,'ymin)
- ngy := htpLabelInputString(htPage,'ngy)
- ymax := htpLabelInputString(htPage,'ymax)
- alpha := htpLabelInputString(htPage,'alpha)
- beta := htpLabelInputString(htPage,'beta)
- gamma := htpLabelInputString(htPage,'gamma)
- delta := htpLabelInputString(htPage,'delta)
- epsilon := htpLabelInputString(htPage,'epsilon)
- phi := htpLabelInputString(htPage,'phi)
- psi := htpLabelInputString(htPage,'psi)
- ba := htpLabelInputString(htPage,'ba)
- bb := htpLabelInputString(htPage,'bb)
- bc := htpLabelInputString(htPage,'bc)
- ta := htpLabelInputString(htPage,'ta)
- tb := htpLabelInputString(htPage,'tb)
- tc := htpLabelInputString(htPage,'tc)
- la := htpLabelInputString(htPage,'la)
- lb := htpLabelInputString(htPage,'lb)
- lc := htpLabelInputString(htPage,'lc)
- ra := htpLabelInputString(htPage,'ra)
- rb := htpLabelInputString(htPage,'rb)
- rc := htpLabelInputString(htPage,'rc)
- tol := htpLabelInputString(htPage,'tol)
- bCond := STRCONC('"[[ ", ba, '", ", bb, '", ", bc, '"],")
- bCond := STRCONC(bCond, '"[ ", ra, '", ", rb, '", ", rc, '"],")
- bCond := STRCONC(bCond, '"[ ", ta, '", ", tb, '", ", tc, '"],")
- bCond := STRCONC(bCond, '"[ ", la, '", ", lb, '", ", lc, '"]]")
- pde := STRCONC('"[", alpha, '", ", beta, '", ", gamma, '", ", delta)
- pde := STRCONC( pde, '", ", epsilon, '", ", phi, '", ", psi, '"]")
- outputString := STRCONC('"solve(", xmin, '", ", xmax, '", ", ymin, '", ", ymax, '", ")
- outputString := STRCONC(outputString , ngx, '", ", ngy, '", ", pde, '", ")
- outputString := STRCONC(outputString , bCond, '", _"", ell ,'"_", ", tol, " )")
- annaGen outputString
-
-annaOpt() ==
- htInitPage('"Minimization of a Multivariate Function using AXIOM/NAG Expert System",nil)
- htMakePage '(
- (domainConditions
- (isDomain F (Float))
- (isDomain NNI (NonNegativeInteger))
- (isDomain S (String))
- (isDomain PI (PositiveInteger))
- (isDomain I (Integer))
- (isDomain EM $EmptyMode))
- (text . "Analyses the function for various attributes, chooses and ")
- (text . "then uses a suitable optimization routine for finding the ")
- (text . "minimum of a nonlinear function {\it F(x)} of {\it n} variables.")
- (text . "\newline {\bf Minimize F(x)} where \center{\htbitmap{e04fdf1}} possibly subject to linear or non-linear ")
- (text . "constraints on the variables. ")
- (text . "\blankline ")
- (text . "\menuitemstyle{}\tab{2}")
- (text . "Number of variables \htbitmap{xj}, {\it n}:")
- (text . "\space{1} ")
- (bcStrings (2 4 n PI))
- (text . "\blankline ")
- (text . "\newline \menuitemstyle{} \tab{2} Are there any constraints ")
- (text . "on the function?")
- (radioButtons constraints
- (" " " No" nocons)
- (" " " Yes" cFunctions))
- (text . "\blankline \menuitemstyle{}")
- (text . "Number of linear and/or non-linear constraint functions:\space{1}")
- (bcStrings (2 "0" cons NNI))
- (text . "\blankline "))
- htMakeDoneButton('"Continue",'annaOptSolve)
- htShowPage()
-
-annaOptSolve htPage ==
- n :=
- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
- objValUnwrap htpLabelSpadValue(htPage, 'n)
- c := htpButtonValue(htPage,'constraints)
- constraints :=
- c = 'nocons => '"none"
- '"cf"
- cons :=
- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'cons)
- objValUnwrap htpLabelSpadValue(htPage, 'cons)
- constraints = '"none" => annaOptSolve1(n)
- ((n = '4) and (cons = '0)) => annaOptDefaultSolve2()
- ((n = '4) and (cons = '3)) => annaOptDefaultSolve3()
- ((n = '7) and (cons = '7)) => annaOptDefaultSolve4()
- cText := ('"\blankline \menuitemstyle{}\tab{2} Enter lower and upper ")
- cText := STRCONC(cText,'"boundary conditions {\it bl(n)} and {\it bu(n)}: ")
- cText := STRCONC(cText,'"\newline \tab{5} Lower \tab{25} Constraint ")
- cText := STRCONC(cText,'"\tab{45} Upper ")
- cList :=
- "append"/[fc(i) for i in 1..n] where fc(i) ==
- prefix := ('"\newline \tab{2}")
- xn := INTERN STRCONC ("\tab{27}",'"X",STRINGIMAGE i,"\tab{42}")
- blnam := INTERN STRCONC ('"bl",STRINGIMAGE i)
- bunam := INTERN STRCONC ('"bu",STRINGIMAGE i)
- [['text,:prefix],['bcStrings,[8, '"-1.0", blnam, 'F]],['text,:xn],
- ['bcStrings,[8, '"1.0", bunam, 'F]]]
- consList :=
- "append"/[fe(i) for i in n+1..n+cons] where fe(i) ==
- lineEnd := ('"\newline\tab{2}")
- space := ('"\space{1}")
- space2 := ('"\tab{42}")
- cnam := INTERN STRCONC ('"c",STRINGIMAGE i)
- blnam := INTERN STRCONC ('"bl",STRINGIMAGE i)
- bunam := INTERN STRCONC ('"bu",STRINGIMAGE i)
- [['text,:lineEnd],['bcStrings,[8, '"-1.0", blnam, 'F]],['text,:space],
- ['bcStrings,[26, '"X[1]", cnam, 'EM]],['text,:space2],
- ['bcStrings,[8, '"1.0", bunam, 'F]]]
- cList := [['text,:cText],:cList,:consList]
- funcList := [['bcStrings,[48, '"X[1]", 'f, 'EM]]]
- xmiddle := ('"\blankline \menuitemstyle{}\tab{2} Enter initial guess of the")
- xmiddle := STRCONC(xmiddle,'" solution vector {\it x(n)}: ")
- xList :=
- "append"/[fg(i) for i in 1..n] where fg(i) ==
- xnam := INTERN STRCONC ('"x",STRINGIMAGE i)
- [['text,'"\newline\tab{2}"],['bcStrings,[8, '"0.0", xnam, 'F]]]
- xList := [['text,:xmiddle],:xList]
- equationPart := [
- '(domainConditions
- (isDomain EM $EmptyMode)
- (isDomain F (Float))),
- :funcList,:cList,:xList]
- page := htInitPage('"Minimization of a Multivariate Function using AXIOM/NAG Expert System", nil)
- htSay '"\menuitemstyle{}\tab{2} "
- htSay '"Enter the objective function, {\it F(x)} in terms of X[1]...X[n]: "
- htSay '"\newline \tab{2} "
- htMakePage equationPart
- htMakeDoneButton('"Continue",'annaOptGen)
- htpSetProperty(page,'constraints,constraints)
- htpSetProperty(page,'cons,cons)
- htpSetProperty(page,'n,n)
- htShowPage()
-
-annaOptSolve1(n) ==
-
- n = '2 => annaOptDefaultSolve1()
- constraints := '"none"
- cons := '0
- funcList := [['bcStrings,[48, "X[1]", 'f, 'EM]]]
- xmiddle := ('"\blankline \menuitemstyle{}\tab{2} Enter initial guess of the")
- xmiddle := STRCONC(xmiddle,'" solution vector {\it x(n)}: ")
- xList :=
- "append"/[fg(i) for i in 1..n] where fg(i) ==
- xnam := INTERN STRCONC ('"x",STRINGIMAGE i)
- [['text,'"\newline\tab{2}"],['bcStrings,[8, '"0.0", xnam, 'F]]]
- xList := [['text,:xmiddle],:xList]
- equationPart := [
- '(domainConditions
- (isDomain EM $EmptyMode)
- (isDomain F (Float))),
- :funcList,:xList]
- page := htInitPage('"Minimization of a Multivariate Function using AXIOM/NAG Expert System", nil)
- htSay '"\menuitemstyle{}\tab{2} "
- htSay '"Enter the objective function, {\it F(x)} in terms of X[1]...X[n]: "
- htSay '"\newline \tab{2} "
- htMakePage equationPart
- htMakeDoneButton('"Continue",'annaOptGen)
- htpSetProperty(page,'constraints,constraints)
- htpSetProperty(page,'cons,cons)
- htpSetProperty(page,'n,n)
- htShowPage()
-
-annaOptDefaultSolve5() ==
- n := '7
- constraints := '"cf"
- cons := '7
- page := htInitPage('"Minimization of a Multivariate Function using AXIOM/NAG Expert System", nil)
- htMakePage '(
- (domainConditions
- (isDomain F (Float))
- (isDomain EM $EmptyMode))
- (text . "\menuitemstyle{}\tab{2} ")
- (text . "Enter the objective function, {\it F(x)} in terms of X[1]...X[n]: ")
- (text . "\newline \tab{2} ")
- (bcStrings (51 "(X[1]-0.02)*X[1]+(X[2]-0.2)*X[2]+(X[3]-0.2)*X[3]+(X[4]+2*X[3]-0.2)*X[4]+(X[5]-0.2)*X[5]+(0.04-X[6])*X[6]+(0.04-2*X[6]-X[7])*X[7]" f EM))
- (text . "\blankline \menuitemstyle{}\tab{2} Enter lower and upper ")
- (text . "boundary conditions {\it bl(n)} and {\it bu(n)}: ")
- (text . "\newline \tab{5} Lower \tab{25} Constraint \tab{45} Upper ")
- (text . "\newline \tab{2}")
- (bcStrings (8 "-0.01" bl1 F))
- (text . "\tab{27} X1 \tab{42}")
- (bcStrings (8 "0.01" bu1 F))
- (text . "\newline \tab{2}")
- (bcStrings (8 "-0.1" bl2 F))
- (text . "\tab{27} X2 \tab{42}")
- (bcStrings (8 "0.15" bu2 F))
- (text . "\newline \tab{2}")
- (bcStrings (8 "-0.01" bl3 F))
- (text . "\tab{27} X3 \tab{42}")
- (bcStrings (8 "0.03" bu3 F))
- (text . "\newline \tab{2}")
- (bcStrings (8 "-0.04" bl4 F))
- (text . "\tab{27} X4 \tab{42}")
- (bcStrings (8 "0.04" bu4 F))
- (text . "\newline \tab{2}")
- (bcStrings (8 "-0.1" bl5 F))
- (text . "\tab{27} X5 \tab{42}")
- (bcStrings (8 "0.05" bu5 F))
- (text . "\newline \tab{2}")
- (bcStrings (8 "-0.01" bl6 F))
- (text . "\tab{27} X6 \tab{42}")
- (bcStrings (8 "1.0E21" bu6 F))
- (text . "\newline \tab{2}")
- (bcStrings (8 "-0.01" bl7 F))
- (text . "\tab{27} X7 \tab{42}")
- (bcStrings (8 "1.0E21" bu7 F))
- (text . "\newline \tab{2}")
- (bcStrings (8 "-0.13" bl8 F))
- (text . "\space{1}")
- (bcStrings (26 "X[1]+X[2]+X[3]+X[4]+X[5]+X[6]+X[7]" c8 EM))
- (text . "\tab{42}")
- (bcStrings (8 "-0.13" bu8 F))
- (text . "\newline \tab{2}")
- (bcStrings (8 "-1.0E21" bl9 F))
- (text . "\space{1}")
- (bcStrings (26 "0.15*X[1]+0.04*X[2]+0.02*X[3]+0.04*X[4]+0.02*X[5]+0.01*X[6]+0.03*X[7]" c9 EM))
- (text . "\tab{42}")
- (bcStrings (8 "-0.0049" bu9 F))
- (text . "\newline \tab{2}")
- (bcStrings (8 "-1.0E21" bl10 F))
- (text . "\space{1}")
- (bcStrings (26 "0.03*X[1]+0.05*X[2]+0.08*X[3]+0.02*X[4]+0.06*X[5]+0.01*X[6]" c10 EM))
- (text . "\tab{42}")
- (bcStrings (8 "-0.0064" bu10 F))
- (text . "\newline \tab{2}")
- (bcStrings (8 "-1.0E21" bl11 F))
- (text . "\space{1}")
- (bcStrings (26 "0.02*X[1]+0.04*X[2]+0.01*X[3]+0.02*X[4]+0.02*X[5]" c11 EM))
- (text . "\tab{42}")
- (bcStrings (8 "-0.0037" bu11 F))
- (text . "\newline \tab{2}")
- (bcStrings (8 "-1.0E21" bl12 F))
- (text . "\space{1}")
- (bcStrings (26 "0.02*X[1]+0.03*X[2]+0.01*X[5]" c12 EM))
- (text . "\tab{42}")
- (bcStrings (8 "-0.0012" bu12 F))
- (text . "\newline \tab{2}")
- (bcStrings (8 "-0.0992" bl13 F))
- (text . "\space{1}")
- (bcStrings (26 "0.7*X[1]+0.75*X[2]+0.8*X[3]+0.75*X[4]+0.8*X[5]+0.97*X[6]" c13 EM))
- (text . "\tab{42}")
- (bcStrings (8 "1.0E21" bu13 F))
- (text . "\newline \tab{2}")
- (bcStrings (8 "-0.003" bl14 F))
- (text . "\space{1}")
- (bcStrings (26 "0.02*X[1]+0.06*X[2]+0.08*X[3]+0.12*X[4]+0.02*X[5]+0.01*X[6]+0.97*X[7]" c14 EM))
- (text . "\tab{42}")
- (bcStrings (8 "0.002" bu14 F))
- (text . "\blankline \menuitemstyle{}\tab{2} Enter initial guess of the")
- (text . " solution vector {\it x(n)}: \newline \tab{2} ")
- (bcStrings (8 "-0.01" x1 F))
- (text . "\newline\tab{2}")
- (bcStrings (8 "-0.03" x2 F))
- (text . "\newline\tab{2}")
- (bcStrings (8 "0.0" x3 F))
- (text . "\newline\tab{2}")
- (bcStrings (8 "-0.01" x4 F))
- (text . "\newline\tab{2}")
- (bcStrings (8 "-0.1" x5 F))
- (text . "\newline\tab{2}")
- (bcStrings (8 "0.02" x6 F))
- (text . "\newline\tab{2}")
- (bcStrings (8 "0.01" x7 F))
- (text . "\blankline"))
- htMakeDoneButton('"Continue",'annaOptGen)
- htpSetProperty(page,'constraints,constraints)
- htpSetProperty(page,'cons,cons)
- htpSetProperty(page,'n,n)
- htShowPage()
-
-annaOptDefaultSolve4() ==
- n := '7
- constraints := '"cf"
- cons := '7
- page := htInitPage('"Minimization of a Multivariate Function using AXIOM/NAG Expert System", nil)
- htMakePage '(
- (domainConditions
- (isDomain F (Float))
- (isDomain EM $EmptyMode))
- (text . "\menuitemstyle{}\tab{2} ")
- (text . "Enter the objective function, {\it F(x)} in terms of X[1]...X[n]: ")
- (text . "\newline \tab{2} ")
- (bcStrings (51 "-0.2*(0.1*X[1]+X[2]+X[3]+X[4]+X[5]-0.2*(X[6]+X[7]))" f EM))
- (text . "\blankline \menuitemstyle{}\tab{2} Enter lower and upper ")
- (text . "boundary conditions {\it bl(n)} and {\it bu(n)}: ")
- (text . "\newline \tab{5} Lower \tab{25} Constraint \tab{45} Upper ")
- (text . "\newline \tab{2}")
- (bcStrings (8 "-0.01" bl1 F))
- (text . "\tab{27} X1 \tab{42}")
- (bcStrings (8 "0.01" bu1 F))
- (text . "\newline \tab{2}")
- (bcStrings (8 "-0.1" bl2 F))
- (text . "\tab{27} X2 \tab{42}")
- (bcStrings (8 "0.15" bu2 F))
- (text . "\newline \tab{2}")
- (bcStrings (8 "-0.01" bl3 F))
- (text . "\tab{27} X3 \tab{42}")
- (bcStrings (8 "0.03" bu3 F))
- (text . "\newline \tab{2}")
- (bcStrings (8 "-0.04" bl4 F))
- (text . "\tab{27} X4 \tab{42}")
- (bcStrings (8 "0.04" bu4 F))
- (text . "\newline \tab{2}")
- (bcStrings (8 "-0.1" bl5 F))
- (text . "\tab{27} X5 \tab{42}")
- (bcStrings (8 "0.05" bu5 F))
- (text . "\newline \tab{2}")
- (bcStrings (8 "-0.01" bl6 F))
- (text . "\tab{27} X6 \tab{42}")
- (bcStrings (8 "1.0E21" bu6 F))
- (text . "\newline \tab{2}")
- (bcStrings (8 "-0.01" bl7 F))
- (text . "\tab{27} X7 \tab{42}")
- (bcStrings (8 "1.0E21" bu7 F))
- (text . "\newline \tab{2}")
- (bcStrings (8 "-0.13" bl8 F))
- (text . "\space{1}")
- (bcStrings (26 "X[1]+X[2]+X[3]+X[4]+X[5]+X[6]+X[7]" c8 EM))
- (text . "\tab{42}")
- (bcStrings (8 "-0.13" bu8 F))
- (text . "\newline \tab{2}")
- (bcStrings (8 "-1.0E21" bl9 F))
- (text . "\space{1}")
- (bcStrings (26 "0.15*X[1]+0.04*X[2]+0.02*X[3]+0.04*X[4]+0.02*X[5]+0.01*X[6]+0.03*X[7]" c9 EM))
- (text . "\tab{42}")
- (bcStrings (8 "-0.0049" bu9 F))
- (text . "\newline \tab{2}")
- (bcStrings (8 "-1.0E21" bl10 F))
- (text . "\space{1}")
- (bcStrings (26 "0.03*X[1]+0.05*X[2]+0.08*X[3]+0.02*X[4]+0.06*X[5]+0.01*X[6]" c10 EM))
- (text . "\tab{42}")
- (bcStrings (8 "-0.0064" bu10 F))
- (text . "\newline \tab{2}")
- (bcStrings (8 "-1.0E21" bl11 F))
- (text . "\space{1}")
- (bcStrings (26 "0.02*X[1]+0.04*X[2]+0.01*X[3]+0.02*X[4]+0.02*X[5]" c11 EM))
- (text . "\tab{42}")
- (bcStrings (8 "-0.0037" bu11 F))
- (text . "\newline \tab{2}")
- (bcStrings (8 "-1.0E21" bl12 F))
- (text . "\space{1}")
- (bcStrings (26 "0.02*X[1]+0.03*X[2]+0.01*X[5]" c12 EM))
- (text . "\tab{42}")
- (bcStrings (8 "-0.0012" bu12 F))
- (text . "\newline \tab{2}")
- (bcStrings (8 "-0.0992" bl13 F))
- (text . "\space{1}")
- (bcStrings (26 "0.7*X[1]+0.75*X[2]+0.8*X[3]+0.75*X[4]+0.8*X[5]+0.97*X[6]" c13 EM))
- (text . "\tab{42}")
- (bcStrings (8 "1.0E21" bu13 F))
- (text . "\newline \tab{2}")
- (bcStrings (8 "-0.003" bl14 F))
- (text . "\space{1}")
- (bcStrings (26 "0.02*X[1]+0.06*X[2]+0.08*X[3]+0.12*X[4]+0.02*X[5]+0.01*X[6]+0.97*X[7]" c14 EM))
- (text . "\tab{42}")
- (bcStrings (8 "0.002" bu14 F))
- (text . "\blankline \menuitemstyle{}\tab{2} Enter initial guess of the")
- (text . " solution vector {\it x(n)}: \newline \tab{2} ")
- (bcStrings (8 "-0.01" x1 F))
- (text . "\newline\tab{2}")
- (bcStrings (8 "-0.03" x2 F))
- (text . "\newline\tab{2}")
- (bcStrings (8 "0.0" x3 F))
- (text . "\newline\tab{2}")
- (bcStrings (8 "-0.01" x4 F))
- (text . "\newline\tab{2}")
- (bcStrings (8 "-0.1" x5 F))
- (text . "\newline\tab{2}")
- (bcStrings (8 "0.02" x6 F))
- (text . "\newline\tab{2}")
- (bcStrings (8 "0.01" x7 F))
- (text . "\blankline"))
- htMakeDoneButton('"Continue",'annaOptGen)
- htpSetProperty(page,'constraints,constraints)
- htpSetProperty(page,'cons,cons)
- htpSetProperty(page,'n,n)
- htShowPage()
-
-annaOptDefaultSolve3() ==
- n := '4
- constraints := '"cf"
- cons := '3
- page := htInitPage('"Minimization of a Multivariate Function using AXIOM/NAG Expert System", nil)
- htMakePage '(
- (domainConditions
- (isDomain F (Float))
- (isDomain EM $EmptyMode))
- (text . "\menuitemstyle{}\tab{2} ")
- (text . "Enter the objective function, {\it F(x)} in terms of X[1]...X[n]: ")
- (text . "\newline \tab{2} ")
- (bcStrings (48 "X[1]*X[4]*(X[1]+X[2]+X[3])+X[3]" f EM))
- (text . "\blankline \menuitemstyle{}\tab{2} Enter lower and upper ")
- (text . "boundary conditions {\it bl(n)} and {\it bu(n)}: ")
- (text . "\newline \tab{5} Lower \tab{25} Constraint \tab{45} Upper ")
- (text . "\newline \tab{2}")
- (bcStrings (8 "1.0" bl1 F))
- (text . "\tab{27} X1 \tab{42}")
- (bcStrings (8 "5.0" bu1 F))
- (text . "\newline \tab{2}")
- (bcStrings (8 "1.0" bl2 F))
- (text . "\tab{27} X2 \tab{42}")
- (bcStrings (8 "5.0" bu2 F))
- (text . "\newline \tab{2}")
- (bcStrings (8 "1.0" bl3 F))
- (text . "\tab{27} X3 \tab{42}")
- (bcStrings (8 "5.0" bu3 F))
- (text . "\newline \tab{2}")
- (bcStrings (8 "1.0" bl4 F))
- (text . "\tab{27} X4 \tab{42}")
- (bcStrings (8 "5.0" bu4 F))
- (text . "\newline \tab{2}")
- (bcStrings (8 "-1.E25" bl5 F))
- (text . "\space{1}")
- (bcStrings (26 "X[1]+X[2]+X[3]+X[4]" c5 EM))
- (text . "\tab{42}")
- (bcStrings (8 "20.0" bu5 F))
- (text . "\newline \tab{2}")
- (bcStrings (8 "-1.E25" bl6 F))
- (text . "\space{1}")
- (bcStrings (26 "X[1]**2+X[2]**2+X[3]**2+X[4]**2" c6 EM))
- (text . "\tab{42}")
- (bcStrings (8 "40.0" bu6 F))
- (text . "\newline \tab{2}")
- (bcStrings (8 "25.0" bl7 F))
- (text . "\space{1}")
- (bcStrings (26 "X[1]*X[2]*X[3]*X[4]" c7 EM))
- (text . "\tab{42}")
- (bcStrings (8 "1.E25" bu7 F))
- (text . "\blankline \menuitemstyle{}\tab{2} Enter initial guess of the")
- (text . " solution vector {\it x(n)}: \newline \tab{2} ")
- (bcStrings (8 "1.0" x1 F))
- (text . "\newline\tab{2}")
- (bcStrings (8 "5.0" x2 F))
- (text . "\newline\tab{2}")
- (bcStrings (8 "5.0" x3 F))
- (text . "\newline\tab{2}")
- (bcStrings (8 "1.0" x4 F))
- (text . "\blankline"))
- htMakeDoneButton('"Continue",'annaOptGen)
- htpSetProperty(page,'constraints,constraints)
- htpSetProperty(page,'cons,cons)
- htpSetProperty(page,'n,n)
- htShowPage()
-
-annaOptDefaultSolve2() ==
- n := '4
- constraints := '"cf"
- cons := '0
- page := htInitPage('"Minimization of a Multivariate Function using AXIOM/NAG Expert System", nil)
- htMakePage '(
- (domainConditions
- (isDomain F (Float))
- (isDomain EM $EmptyMode))
- (text . "\menuitemstyle{}\tab{2} ")
- (text . "Enter the objective function, {\it F(x)} in terms of X[1]...X[n]: ")
- (text . "\newline \tab{2} ")
- (bcStrings (70 "(X[1]+10*X[2])**2+5*(X[3]-X[4])**2+(X[2]-2*X[3])**4+10*(X[1]-X[4])**4" f EM))
- (text . "\blankline \menuitemstyle{}\tab{2} Enter lower and upper ")
- (text . "boundary conditions {\it bl(n)} and {\it bu(n)}: ")
- (text . "\newline \tab{5} Lower \tab{25} Constraint \tab{45} Upper ")
- (text . "\newline \tab{2}")
- (bcStrings (8 "1" bl1 F))
- (text . "\tab{27} X1 \tab{42}")
- (bcStrings (8 "3" bu1 F))
- (text . "\newline \tab{2}")
- (bcStrings (8 "-2" bl2 F))
- (text . "\tab{27} X2 \tab{42}")
- (bcStrings (8 "0" bu2 F))
- (text . "\newline \tab{2}")
- (bcStrings (8 "-1.0E-6" bl3 F))
- (text . "\tab{27} X3 \tab{42}")
- (bcStrings (8 "1.0E6" bu3 F))
- (text . "\newline \tab{2}")
- (bcStrings (8 "1" bl4 F))
- (text . "\tab{27} X4 \tab{42}")
- (bcStrings (8 "3" bu4 F))
- (text . "\blankline \menuitemstyle{}\tab{2} Enter initial guess of the")
- (text . " solution vector {\it x(n)}: \newline \tab{2} ")
- (bcStrings (8 "3" x1 F))
- (text . "\newline\tab{2}")
- (bcStrings (8 "-1" x2 F))
- (text . "\newline\tab{2}")
- (bcStrings (8 "0" x3 F))
- (text . "\newline\tab{2}")
- (bcStrings (8 "1" x4 F))
- (text . "\blankline"))
- htMakeDoneButton('"Continue",'annaOptGen)
- htpSetProperty(page,'constraints,constraints)
- htpSetProperty(page,'cons,cons)
- htpSetProperty(page,'n,n)
- htShowPage()
-
-annaOptDefaultSolve1() ==
-
- n := '2
- constraints := '"none"
- cons := '0
- page := htInitPage('"Minimization of a Multivariate Function using AXIOM/NAG Expert System", nil)
- htMakePage '(
- (domainConditions
- (isDomain F (Float))
- (isDomain EM $EmptyMode))
- (text . "\menuitemstyle{} \tab{2} Enter the objective function,")
- (text . " {\it F(x)} in terms of X[1]...X[n]: \newline \tab{2} ")
- (bcStrings (52 "exp(X[1])*(4*X[1]**2+2*X[2]**2+4*X[1]*X[2]+2*X[2]+1)" f EM))
- (text . "\blankline \menuitemstyle{} \tab{2} Enter initial guess of the ")
- (text . "solution vector {\it x(n)}: \newline\tab{2}")
- (bcStrings (8 "-1.0" x1 F))
- (text . "\newline\tab{2}")
- (bcStrings (8 "1.0" x2 F))
- (text . "\blankline"))
- htMakeDoneButton('"Continue",'annaOptGen)
- htpSetProperty(page,'constraints,constraints)
- htpSetProperty(page,'cons,cons)
- htpSetProperty(page,'n,n)
- htShowPage()
-
-annaOptGen htPage ==
- n := htpProperty(htPage,'n)
- cons := htpProperty(htPage,'cons)
- constraints := htpProperty(htPage,'constraints)
- alist := htpInputAreaAlist htPage
- y := alist
- for i in 1..n repeat
- init := STRCONC((first y).1,'"")
- initList := [init,:initList]
- y := rest y
- initString := bcwords2liststring initList
- if constraints = '"cf" then
- for i in 1..cons repeat
- upper := STRCONC((first y).1,'"")
- uList := [upper,:uList]
- y := rest y
- con := STRCONC((first y).1," ")
- cList := [con,:cList]
- y := rest y
- lower := STRCONC((first y).1,'"")
- lList := [lower,:lList]
- y := rest y
- for i in 1..n repeat
- upper := STRCONC((first y).1,'"")
- uList := [upper,:uList]
- y := rest y
- lower := STRCONC((first y).1,'"")
- lList := [lower,:lList]
- y := rest y
- uString := bcwords2liststring uList
- cString := bcwords2liststring cList
- lString := bcwords2liststring lList
- f := STRCONC((first y).1,'"")
- prefix := STRCONC('"optimize(",f,", ")
- if constraints = '"none" then
- midfix := initString
- else
- if cons = '0 then
- midfix := STRCONC(initString,", ",lString,", ",uString)
- else
- midfix := STRCONC(initString,", ",lString,", ",cString,", ",uString)
- suffix := STRCONC(prefix, midfix,")")
- annaGen suffix
-
-annaOpt2() ==
- htInitPage('"Minimization of a Sum of Squares using AXIOM/NAG Expert System",nil)
- htMakePage '(
- (domainConditions
- (isDomain PI (PositiveInteger)))
- (text . "Analyses the functions for various attributes, chooses and ")
- (text . "then uses a suitable optimization routine for finding the ")
- (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 routines are intended for ")
- (text . "functions which have continous first and second derivatives, ")
- (text . "though they 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 . "\newline \menuitemstyle{} \tab{2} Do you wish for a check for ")
- (text . "goodness of fit of the least squares model?")
- (radioButtons goodness
- (" " " No" nogood)
- (" " " Yes" good))
- (text . "\blankline "))
- htMakeDoneButton('"Continue", 'annaOpt2Solve)
- htShowPage()
-
-annaOpt2Solve htPage ==
- g := htpButtonValue(htPage,'goodness)
- goodness :=
- g = 'nogood => '"nogood"
- '"good"
- n :=
- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n)
- objValUnwrap htpLabelSpadValue(htPage, 'n)
- m :=
- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm)
- objValUnwrap htpLabelSpadValue(htPage, 'm)
- m = '15 and n = '3 and goodness = '"nogood" => annaOpt2DefaultSolve()
- m = '15 and n = '3 => annaOpt2DefaultSolve2()
- fList :=
- "append"/[f(i) for i in 1..m] where f(i) ==
- lineEnd := ('"\newline\tab{2}")
- fnam := INTERN STRCONC ('"f",STRINGIMAGE i)
- [['text,:lineEnd], ['bcStrings,[42, '"X[1]", fnam, 'EM]]]
- xmiddle := ('"\blankline \menuitemstyle{}\tab{2} Enter initial guess of the")
- xmiddle := STRCONC(xmiddle,'" solution vector {\it x(n)}: ")
- xList :=
- "append"/[fg(i) for i in 1..n] where fg(i) ==
- xnam := INTERN STRCONC ('"x",STRINGIMAGE i)
- [['text,'"\newline\tab{2}"],['bcStrings,[8, '"0.0", xnam, 'F]]]
- xList := [['text,:xmiddle],:xList]
- equationPart := [
- '(domainConditions
- (isDomain EM $EmptyMode)
- (isDomain F (Float))),
- :fList,:xList]
- page := htInitPage('"Minimization of a Sum of Squares using AXIOM/NAG Expert System",nil)
- htSay '"\menuitemstyle{}\tab{2} "
- htSay '"Enter the objective functions, {\it F(x)} in terms of X[1]...X[n]: "
- htSay '"\newline \tab{2} "
- htMakePage equationPart
- htMakeDoneButton('"Continue",'annaOpt2Gen)
- htpSetProperty(page,'n,n)
- htpSetProperty(page,'m,m)
- htpSetProperty(page,'goodness,goodness)
- htShowPage()
-
-annaOpt2DefaultSolve() ==
- goodness := '"nogood"
- n := '3
- m := '15
- page := htInitPage('"Minimization of a Sum of Squares using AXIOM/NAG Expert System",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 X[1]...X[n]: ")
- (text . "\newline ")
- (text . "\newline {\em Function 1:} \space{1}")
- (bcStrings (42 "(X[3]+15*X[2])**(-1)+X[1]-0.14" f1 EM))
- (text . "\newline {\em Function 2:} \space{1}")
- (bcStrings (42 "2*(2*X[3]+14*X[2])**(-1)+X[1]-0.18" f2 EM))
- (text . "\newline {\em Function 3:} \space{1}")
- (bcStrings (42 "3*(3*X[3]+13*X[2])**(-1)+X[1]-0.22" f3 EM))
- (text . "\newline {\em Function 4:} \space{1}")
- (bcStrings (42 "4*(4*X[3]+12*X[2])**(-1)+X[1]-0.25" f4 EM))
- (text . "\newline {\em Function 5:} \space{1}")
- (bcStrings (42 "5*(5*X[3]+11*X[2])**(-1)+X[1]-0.29" f5 EM))
- (text . "\newline {\em Function 6:} \space{1}")
- (bcStrings (42 "6*(6*X[3]+10*X[2])**(-1)+X[1]-0.32" f6 EM))
- (text . "\newline {\em Function 7:} \space{1}")
- (bcStrings (42 "7*(7*X[3]+9*X[2])**(-1)+X[1]-0.35" f7 EM))
- (text . "\newline {\em Function 8:} \space{1}")
- (bcStrings (42 "8*(8*X[3]+8*X[2])**(-1)+X[1]-0.39" f8 EM))
- (text . "\newline {\em Function 9:} \space{1}")
- (bcStrings (42 "9*(7*X[3]+7*X[2])**(-1)+X[1]-0.37" f9 EM))
- (text . "\newline {\em Function 10:} \space{1}")
- (bcStrings (42 "10*(6*X[3]+6*X[2])**(-1)+X[1]-0.58" f10 EM))
- (text . "\newline {\em Function 11:} \space{1}")
- (bcStrings (42 "11*(5*X[3]+5*X[2])**(-1)+X[1]-0.73" f11 EM))
- (text . "\newline {\em Function 12:} \space{1}")
- (bcStrings (42 "12*(4*X[3]+4*X[2])**(-1)+X[1]-0.96" f12 EM))
- (text . "\newline {\em Function 13:} \space{1}")
- (bcStrings (42 "13*(3*X[3]+3*X[2])**(-1)+X[1]-1.34" f13 EM))
- (text . "\newline {\em Function 14:} \space{1}")
- (bcStrings (42 "14*(2*X[3]+2*X[2])**(-1)+X[1]-2.1" f14 EM))
- (text . "\newline {\em Function 15:} \space{1}")
- (bcStrings (42 "15*(X[3]+X[2])**(-1)+X[1]-4.39" f15 EM))
- (text . "\blankline ")
- (text . "\menuitemstyle{}\tab{2}")
- (text . "Enter initial guess of the solution vector {\it x(n)}: \newline \tab{2}")
- (bcStrings (8 "0.5" x1 F))
- (text . "\newline \tab{2}")
- (bcStrings (8 "1.0" x2 F))
- (text . "\newline \tab{2}")
- (bcStrings (8 "1.5" x3 F)))
- htMakeDoneButton('"Continue",'annaOpt2Gen)
- htpSetProperty(page,'n,n)
- htpSetProperty(page,'m,m)
- htpSetProperty(page,'goodness,goodness)
- htShowPage()
-
-annaOpt2DefaultSolve2() ==
- goodness := '"good"
- n := '3
- m := '15
- page := htInitPage('"Minimization of a Sum of Squares using AXIOM/NAG Expert System",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 X[1]...X[n]: ")
- (text . "\newline ")
- (text . "\newline {\em Function 1:} \space{1}")
- (bcStrings (42 "(X[3]+15*X[2])**(-1)+X[1]-0.14" f1 EM))
- (text . "\newline {\em Function 2:} \space{1}")
- (bcStrings (42 "2*(2*X[3]+14*X[2])**(-1)+X[1]-0.18" f2 EM))
- (text . "\newline {\em Function 3:} \space{1}")
- (bcStrings (42 "3*(3*X[3]+13*X[2])**(-1)+X[1]-0.22" f3 EM))
- (text . "\newline {\em Function 4:} \space{1}")
- (bcStrings (42 "4*(4*X[3]+12*X[2])**(-1)+X[1]-0.25" f4 EM))
- (text . "\newline {\em Function 5:} \space{1}")
- (bcStrings (42 "5*(5*X[3]+11*X[2])**(-1)+X[1]-0.29" f5 EM))
- (text . "\newline {\em Function 6:} \space{1}")
- (bcStrings (42 "6*(6*X[3]+10*X[2])**(-1)+X[1]-0.32" f6 EM))
- (text . "\newline {\em Function 7:} \space{1}")
- (bcStrings (42 "7*(7*X[3]+9*X[2])**(-1)+X[1]-0.35" f7 EM))
- (text . "\newline {\em Function 8:} \space{1}")
- (bcStrings (42 "8*(8*X[3]+8*X[2])**(-1)+X[1]-0.39" f8 EM))
- (text . "\newline {\em Function 9:} \space{1}")
- (bcStrings (42 "9*(7*X[3]+7*X[2])**(-1)+X[1]-0.37" f9 EM))
- (text . "\newline {\em Function 10:} \space{1}")
- (bcStrings (42 "10*(6*X[3]+6*X[2])**(-1)+X[1]-0.58" f10 EM))
- (text . "\newline {\em Function 11:} \space{1}")
- (bcStrings (42 "11*(5*X[3]+5*X[2])**(-1)+X[1]-0.73" f11 EM))
- (text . "\newline {\em Function 12:} \space{1}")
- (bcStrings (42 "12*(4*X[3]+4*X[2])**(-1)+X[1]-0.96" f12 EM))
- (text . "\newline {\em Function 13:} \space{1}")
- (bcStrings (42 "13*(3*X[3]+3*X[2])**(-1)+X[1]-1.34" f13 EM))
- (text . "\newline {\em Function 14:} \space{1}")
- (bcStrings (42 "14*(2*X[3]+2*X[2])**(-1)+X[1]-2.1" f14 EM))
- (text . "\newline {\em Function 15:} \space{1}")
- (bcStrings (42 "15*(X[3]+X[2])**(-1)+X[1]-4.39" f15 EM))
- (text . "\blankline ")
- (text . "\menuitemstyle{}\tab{2}")
- (text . "Enter initial guess of the solution vector {\it x(n)}: \newline \tab{2}")
- (bcStrings (8 "0.5" x1 F))
- (text . "\newline \tab{2}")
- (bcStrings (8 "1.0" x2 F))
- (text . "\newline \tab{2}")
- (bcStrings (8 "1.5" x3 F)))
- htMakeDoneButton('"Continue",'annaOpt2Gen)
- htpSetProperty(page,'n,n)
- htpSetProperty(page,'m,m)
- htpSetProperty(page,'goodness,goodness)
- htShowPage()
-
-annaOpt2Gen htPage ==
-
- goodness := htpProperty(htPage,'goodness)
- n := htpProperty(htPage,'n)
- m := htpProperty(htPage,'m)
- alist := htpInputAreaAlist htPage
- y := alist
- for i in 1..n repeat
- init := STRCONC((first y).1,'"")
- initList := [init,:initList]
- y := rest y
- initString := bcwords2liststring initList
- for i in 1..m repeat
- f := STRCONC((first y).1," ")
- fList := [f,:fList]
- y := rest y
- fString := bcwords2liststring fList
- prefix :=
- goodness = '"good" => '"goodnessOfFit( "
- '"optimize( "
- midfix := STRCONC(fString,", ",initString)
- suffix := STRCONC(prefix, midfix,")")
- annaGen suffix
diff --git a/src/interp/nag-c02.boot b/src/interp/nag-c02.boot
deleted file mode 100644
index a8661a63..00000000
--- a/src/interp/nag-c02.boot
+++ /dev/null
@@ -1,299 +0,0 @@
--- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
--- All rights reserved.
--- Copyright (C) 2007, Gabriel Dos Reis.
--- 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.
-
-
-import '"macros"
-)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-c05.boot b/src/interp/nag-c05.boot
deleted file mode 100644
index 36f418b7..00000000
--- a/src/interp/nag-c05.boot
+++ /dev/null
@@ -1,407 +0,0 @@
--- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
--- All rights reserved.
--- Copyright (C) 2007, Gabriel Dos Reis.
--- 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.
-
-
-import '"macros"
-)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-c06.boot b/src/interp/nag-c06.boot
deleted file mode 100644
index 90c812c0..00000000
--- a/src/interp/nag-c06.boot
+++ /dev/null
@@ -1,1837 +0,0 @@
--- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
--- All rights reserved.
--- Copyright (C) 2007, Gabriel Dos Reis.
--- 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.
-
-
-import '"macros"
-)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-d01.boot b/src/interp/nag-d01.boot
deleted file mode 100644
index 57a60063..00000000
--- a/src/interp/nag-d01.boot
+++ /dev/null
@@ -1,1342 +0,0 @@
--- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
--- All rights reserved.
--- Copyright (C) 2007, Gabriel Dos Reis.
--- 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.
-
-
-import '"macros"
-)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-d02.boot b/src/interp/nag-d02.boot
deleted file mode 100644
index db6a636e..00000000
--- a/src/interp/nag-d02.boot
+++ /dev/null
@@ -1,2151 +0,0 @@
--- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
--- All rights reserved.
--- Copyright (C) 2007, Gabriel Dos Reis.
--- 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.
-
-
-import '"macros"
-)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-d03.boot b/src/interp/nag-d03.boot
deleted file mode 100644
index d92a61d8..00000000
--- a/src/interp/nag-d03.boot
+++ /dev/null
@@ -1,644 +0,0 @@
--- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
--- All rights reserved.
--- Copyright (C) 2007, Gabriel Dos Reis.
--- 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.
-
-
-import '"macros"
-)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-e01.boot b/src/interp/nag-e01.boot
deleted file mode 100644
index 251758dd..00000000
--- a/src/interp/nag-e01.boot
+++ /dev/null
@@ -1,1763 +0,0 @@
--- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
--- All rights reserved.
--- Copyright (C) 2007, Gabriel Dos Reis.
--- 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.
-
-
-import '"macros"
-)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-e02.boot b/src/interp/nag-e02.boot
deleted file mode 100644
index 6bdbb392..00000000
--- a/src/interp/nag-e02.boot
+++ /dev/null
@@ -1,4676 +0,0 @@
--- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
--- All rights reserved.
--- Copyright (C) 2007, Gabriel Dos Reis.
--- 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.
-
-
-import '"macros"
-)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-e02b.boot b/src/interp/nag-e02b.boot
deleted file mode 100644
index caf842c6..00000000
--- a/src/interp/nag-e02b.boot
+++ /dev/null
@@ -1,1740 +0,0 @@
--- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
--- All rights reserved.
--- Copyright (C) 2007, Gabriel Dos Reis.
--- 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.
-
-
-import '"macros"
-)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-e04.boot b/src/interp/nag-e04.boot
deleted file mode 100644
index 80f5f5f1..00000000
--- a/src/interp/nag-e04.boot
+++ /dev/null
@@ -1,2503 +0,0 @@
--- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
--- All rights reserved.
--- Copyright (C) 2007, Gabriel Dos Reis.
--- 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.
-
-
-import '"macros"
-)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-f01.boot b/src/interp/nag-f01.boot
deleted file mode 100644
index 69323b88..00000000
--- a/src/interp/nag-f01.boot
+++ /dev/null
@@ -1,2235 +0,0 @@
--- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
--- All rights reserved.
--- Copyright (C) 2007, Gabriel Dos Reis.
--- 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.
-
-
-import '"macros"
-)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-f02.boot b/src/interp/nag-f02.boot
deleted file mode 100644
index 6de20f9e..00000000
--- a/src/interp/nag-f02.boot
+++ /dev/null
@@ -1,2738 +0,0 @@
--- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
--- All rights reserved.
--- Copyright (C) 2007, Gabriel Dos Reis.
--- 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.
-
-
-import '"macros"
-)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-f04.boot b/src/interp/nag-f04.boot
deleted file mode 100644
index 9723f522..00000000
--- a/src/interp/nag-f04.boot
+++ /dev/null
@@ -1,2314 +0,0 @@
--- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
--- All rights reserved.
--- Copyright (C) 2007, Gabriel Dos Reis.
--- 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.
-
-
-import '"macros"
-)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-f07.boot b/src/interp/nag-f07.boot
deleted file mode 100644
index d64d5c89..00000000
--- a/src/interp/nag-f07.boot
+++ /dev/null
@@ -1,709 +0,0 @@
--- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
--- All rights reserved.
--- Copyright (C) 2007, Gabriel Dos Reis.
--- 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.
-
-
-import '"macros"
-)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-s.boot b/src/interp/nag-s.boot
deleted file mode 100644
index 2518d2e6..00000000
--- a/src/interp/nag-s.boot
+++ /dev/null
@@ -1,1587 +0,0 @@
--- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
--- All rights reserved.
--- Copyright (C) 2007, Gabriel Dos Reis.
--- 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.
-
-
-import '"macros"
-)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/patches.lisp b/src/interp/patches.lisp
index d99e6b06..b851f085 100644
--- a/src/interp/patches.lisp
+++ b/src/interp/patches.lisp
@@ -157,7 +157,6 @@
;; non-interactive restarts...
(defun restart0 ()
-#+(and :NAG :ccl) (lisp::init-lm 0)
(compressopen);; set up the compression tables
(interpopen);; open up the interpreter database
(operationopen);; all of the operations known to the system
diff --git a/src/interp/setq.lisp b/src/interp/setq.lisp
index 992ad396..e62c3676 100644
--- a/src/interp/setq.lisp
+++ b/src/interp/setq.lisp
@@ -85,9 +85,9 @@
(SETQ |$insideCompileBodyIfTrue| NIL)
(SETQ |$globalExposureGroupAlist| NIL)
(SETQ |$localExposureDataDefault|
- (VECTOR (LIST '|basic| '|categories| '|naglink| '|anna| ) NIL NIL))
+ (VECTOR (LIST '|basic| '|categories|) NIL NIL))
(SETQ |$localExposureData|
- (VECTOR (LIST '|basic| '|categories| '|naglink| '|anna| ) NIL NIL))
+ (VECTOR (LIST '|basic| '|categories|) NIL NIL))
(SETQ |$compilingInputFile| NIL)
(SETQ |$minivectorNames| NIL)
(setq |$ReadingFile| NIL)
@@ -232,9 +232,7 @@
(|restore| . "history )restore")
(|save| . "history )save")
(|startGraphics| . "system $AXIOM/lib/viewman &")
- (|startNAGLink| . "system $AXIOM/lib/nagman &")
(|stopGraphics| . "lisp (|sockSendSignal| 2 15)")
- (|stopNAGLink| . "lisp (|sockSendSignal| 8 15)")
(|time| . "set message time")
(|type| . "set message type")
(|unexpose| . "set expose drop constructor")
diff --git a/src/interp/setvars.boot b/src/interp/setvars.boot
index ffcca4d7..cc1f362c 100644
--- a/src/interp/setvars.boot
+++ b/src/interp/setvars.boot
@@ -389,8 +389,6 @@ describeInputLibraryArgs() ==
-- frame (called initial ):
-- basic
-- categories
--- naglink
--- anna
-- The following constructors are explicitly exposed in the
-- current frame:
@@ -869,63 +867,6 @@ protectSymbols arg ==
describeProtectSymbols()
PROTECT_-SYMBOLS translateYesNo2TrueFalse first arg
---
--- See the section naglink in setvart.boot
--- \begin{verbatim}
--- Current Values of naglink Variables
-
--- Variable Description Current Value
--- -----------------------------------------------------------------
--- host internet address of host for NAGLink localhost
--- persistence number of (fortran) functions to remember 1
--- messages show NAGLink messages on
--- double enforce DOUBLE PRECISION ASPs on
-
---
-
-
-setNagHost arg ==
- arg = "%initialize%" =>
- $nagHost := '"localhost"
- arg = "%display%" =>
- object2String $nagHost
- (null arg) or (arg = "%describe%") or (first arg = '_?) =>
- describeSetNagHost()
- $nagHost := object2String arg
-
-
-describeSetNagHost() ==
- sayBrightly LIST (
- '%b,'")set naglink host",'%d,_
- '"is used to tell AXIOM which host to contact for",'%l,_
- '" a NAGLink request. An Internet address should be supplied. The host",'%l,_
- '" specified must be running the NAGLink daemon.",'%l,'%l,_
- '" The current setting is",'%b,$nagHost,'%d)
-
-
-setFortPers arg ==
- arg = "%initialize%" =>
- $fortPersistence := 1
- arg = "%display%" =>
- $fortPersistence
- (null arg) or (arg = "%describe%") or (first arg = '_?) =>
- describeFortPersistence()
- n := first arg
- ((not FIXP n) or (n < 0)) =>
- sayMessage ['"Your value of",:bright n,'"is invalid because ..."]
- describeFortPersistence()
- terminateSystemCommand()
- $fortPersistence := first(arg)
-
-
-describeFortPersistence() ==
- sayBrightly LIST (
- '%b,'")set naglink persistence",'%d,_
- '"is used to tell the ",'%b,"nagd",'%d," daemon how many ASP",'%l,_
- '" source and object files to keep around in case you reuse them. This helps",'%l,_
- '" to avoid needless recompilations. The number specified should be a ",'%l,_
- '" non-negative integer.", '%l,'%l,_
- '" The current setting is",'%b,$fortPersistence,'%d)
-- See the subsection output algebra in setvart.boot
--
diff --git a/src/interp/setvart.boot b/src/interp/setvart.boot
index be30c3f4..43e1089e 100644
--- a/src/interp/setvart.boot
+++ b/src/interp/setvart.boot
@@ -134,8 +134,6 @@ $setOptions := '(
-- frame (called initial ):
-- basic
-- categories
--- naglink
--- anna
--
-- The following constructors are explicitly exposed in the
-- current frame:
@@ -714,7 +712,6 @@ $setOptions := '(
-- type print type after computation on
-- void print Void value when it occurs off
-- any print the internal type of objects of domain Any on
--- naglink show NAGLink messages on
(messages
"show messages for various system features"
interpreter
@@ -938,25 +935,6 @@ $setOptions := '(
(on off)
on)
--- --------------------- The naglink Option ----------------------
---
--- Description: show NAGLink messages
---
--- The naglink option may be followed by any one of the
--- following:
---
--- -> on
--- off
---
--- The current setting is indicated within the list.
- (naglink
- "show NAGLink messages"
- interpreter
- LITERALS
- $nagMessages
- (on off)
- on)
-
-- ---------------------- The number Option ----------------------
--
-- Description: display message number with message
@@ -1147,100 +1125,6 @@ $setOptions := '(
off)
))
--- Current Values of naglink Variables
---
--- Variable Description Current Value
--- -----------------------------------------------------------------
--- host internet address of host for NAGLink localhost
--- persistence number of (fortran) functions to remember 1
--- messages show NAGLink messages on
--- double enforce DOUBLE PRECISION ASPs on
- (naglink
- "options for NAGLink"
- interpreter
- TREE
- novar
-
--- ----------------------- The host Option -----------------------
---
--- Description: internet address of host for NAGLink
---
--- )set naglink host is used to tell AXIOM which host to contact
--- for a NAGLink request. An Internet address should be supplied.
--- The host specified must be running the NAGLink daemon.
---
--- The current setting is localhost
- ((host
- "internet address of host for NAGLink"
- interpreter
- FUNCTION
- setNagHost
- (("enter host name"
- DIRECTORY
- $nagHost
- chkDirectory
- "localhost"))
- NIL)
--- ------------------- The persistence Option --------------------
---
--- Description: number of (fortran) functions to remember
---
--- )set naglink persistence is used to tell the nagd daemon how
--- many ASP source and object files to keep around in case you
--- reuse them. This helps to avoid needless recompilations. The
--- number specified should be a non-negative integer.
---
--- The current setting is 1
- (persistence
- "number of (fortran) functions to remember"
- interpreter
- FUNCTION
- setFortPers
- (("Requested remote storage (for asps):"
- INTEGER
- $fortPersistence
- (0 NIL)
- 10))
- NIL)
-
--- --------------------- The messages Option ---------------------
---
--- Description: show NAGLink messages
---
--- The messages option may be followed by any one of the
--- following:
---
--- -> on
--- off
---
--- The current setting is indicated within the list.
- (messages
- "show NAGLink messages"
- interpreter
- LITERALS
- $nagMessages
- (on off)
- on)
-
--- ---------------------- The double Option ----------------------
---
--- Description: enforce DOUBLE PRECISION ASPs
---
--- The double option may be followed by any one of the following:
---
--- -> on
--- off
---
--- The current setting is indicated within the list.
- (double
- "enforce DOUBLE PRECISION ASPs"
- interpreter
- LITERALS
- $nagEnforceDouble
- (on off)
- on)
- ))
-
-- Variable Description Current Value
-- -----------------------------------------------------------------
-- abbreviate abbreviate type names off
diff --git a/src/interp/sockio.lisp b/src/interp/sockio.lisp
index de5b8274..48a99f29 100644
--- a/src/interp/sockio.lisp
+++ b/src/interp/sockio.lisp
@@ -168,7 +168,6 @@
(defconstant InterpWindow 6)
(defconstant KillSpad 7)
(defconstant DebugWindow 8)
-(defconstant NAGLinkServer 8)
(defconstant Forker 9)
;; same constants for use in BOOT
@@ -180,7 +179,6 @@
(defconstant |$InterpWindow| InterpWindow)
(defconstant |$KillSpad| KillSpad)
(defconstant |$DebugWindow| DebugWindow)
-(defconstant |$NAGLinkServer| NAGLinkServer)
(defconstant |$Forker| Forker)
;; Session Manager action requests
diff --git a/src/interp/util.lisp b/src/interp/util.lisp
index 7ea4bfd8..ff9af38b 100644
--- a/src/interp/util.lisp
+++ b/src/interp/util.lisp
@@ -483,76 +483,6 @@
|showFrom|
|showImp|))
-;; The {\bf ANNA} subsystem, invoked thru {\bf hypertex}, is an
-;; expert system that understands the Numerical Algorithms Group (NAG)
-;; fortran library.
-(setq anna-functions '(
- |annaInt|
- |annaMInt|
- |annaOde|
- |annaOpt|
- |annaOpt2|
- |annaPDESolve|
- |annaOptDefaultSolve1|
- |annaOptDefaultSolve2|
- |annaOptDefaultSolve3|
- |annaOptDefaultSolve4|
- |annaOptDefaultSolve5|
- |annaOpt2DefaultSolve|
- |annaFoo|
- |annaBar|
- |annaJoe|
- |annaSue|
- |annaAnn|
- |annaBab|
- |annaFnar|
- |annaDan|
- |annaBlah|
- |annaTub|
- |annaRats|
- |annaMInt|
- |annaOdeDefaultSolve1|
- |annaOdeDefaultSolve2|))
-
-;; The Numerical Algorithms Group (NAG) fortran library has a set
-;; of cover functions. These functions need to be loaded if you use
-;; the NAG library.
-(setq nagbr-functions '(
- loadnag
- |c02aff| |c02agf|
- |c05adf| |c05nbf| |c05pbf|
- |c06eaf| |c06ebf| |c06ecf| |c06ekf| |c06fpf| |c06fqf| |c06frf|
- |c06fuf| |c06gbf| |c06gcf| |c06gqf| |c06gsf|
- |d01ajf| |d01akf| |d01alf| |d01amf| |d01anf| |d01apf| |d01aqf|
- |d01asf| |d01bbf| |d01fcf| |d01gaf| |d01gbf|
- |d02bbf| |d02bhf| |d02cjf| |d02ejf| |d02gaf| |d02gbf| |d02kef|
- |d02raf|
- |d03edf| |d03eef| |d03faf|
- |e01baf| |e01bef| |e01bff| |e01bgf| |e01bhf| |e01daf| |e01saf|
- |e01sbf| |e01sef|
- |e02adf| |e02aef| |e02agf| |e02ahf| |e02ajf| |e02akf| |e02baf|
- |e02bbf| |e02bcf| |e02bdf| |e02bef| |e02daf| |e02dcf|
- |e02ddf| |e02def| |e02dff| |e02gaf| |e02zaf|
- |e04dgf| |e04fdf| |e04gcf| |e04jaf| |e04mbf| |e04naf| |e04ucf|
- |e04ycf|
- |f01brf| |f01bsf| |f01maf| |f01mcf| |f01qcf| |f01qdf| |f01qef|
- |f01rcf| |f01rdf| |f01ref|
- |f02aaf| |f02abf| |f02adf| |f02aef| |f02aff| |f02agf| |f02ajf|
- |f02akf| |f02awf| |f02axf| |f02bbf| |f02bjf| |f02fjf|
- |f02wef| |f02xef|
- |f04adf| |f04arf| |f04asf| |f04atf| |f04axf| |f04faf| |f04jgf|
- |f04maf| |f04mbf| |f04mcf| |f04qaf|
- |f07adf| |f07aef| |f07fdf| |f07fef|
- |s01eaf| |s13aaf| |s13acf| |s13adf| |s14aaf| |s14abf| |s14baf|
- |s15adf| |s15aef| |s17acf| |s17adf| |s17aef| |s17aff|
- |s17agf| |s17ahf| |s17ajf| |s17akf| |s17dcf| |s17def|
- |s17dgf| |s17dhf| |s17dlf| |s18acf| |s18adf| |s18aef|
- |s18aff| |s18dcf| |s18def| |s19aaf| |s19abf| |s19acf|
- |s19adf| |s20acf| |s20adf| |s21baf| |s21bbf| |s21bcf|
- |s21bdf|
- ))
-
-
;; This function is called by {\bf build-interpsys}. It takes two lists.
;; The first is a list of functions that need to be used as
;; ``autoload triggers''. The second is a list of files to load if one
@@ -632,8 +562,7 @@
;; loads the databases, sets up autoload triggers and clears out hash tables.
;; After this function is called the image is clean and can be saved.
-(defun build-interpsys (load-files
- translate-files nagbr-files asauto-files)
+(defun build-interpsys (load-files translate-files asauto-files)
(reroot)
#+:AKCL
(init-memory-config :cons 500 :fixnum 200 :symbol 500 :package 8
@@ -653,59 +582,12 @@
(resethashtables)
(setq *load-verbose* nil)
(|setBootAutloadProperties| translate-functions translate-files)
- (|setNAGBootAutloadProperties| nagbr-functions nagbr-files)
(|setBootAutloadProperties| asauto-functions asauto-files)
(setf (symbol-function 'boot::|addConsDB|) #'identity)
(resethashtables) ; the databases into core, then close the streams
)
-;; This is a further refinement of the autoload scheme. Since the
-;; Numerical Algorithms Group (NAG) fortran library contains many
-;; functions we subdivide the NAG library subsystem into chapters.
-;; We use a different helper function {\bf get-NAG-chapter} to decide
-;; which files to load.
-(defun |setNAGBootAutloadProperties| (function-list file-list)
- (mapcar
- #'(lambda (f)
- (|setBootAutloadProperties|
- (get-NAG-chapter (chapter-name f) function-list)
- (nag-files f file-list)))
- file-list))
-
-;; This function is used to find the names of the files to load.
-;; On solaris 9 under GCL the original implementation will fail because
-;; the max number of arguments is 63. We rewrite it to get around this
-;; problem.
-(defun get-NAG-chapter (chapter function-list)
- (let ((l (length chapter)) r)
- (dolist (f function-list)
- (when (equalp chapter (subseq (string f) 0 l))
- (push f r)))
- (nreverse r)))
-
-
-;; We analyze the function names to decide which chapter we are in.
-;; We load files based on the chapter.
-(defun nag-files (filename filelist)
- (apply 'append (mapcar
- #'(lambda (f)
- (cond ((equalp (chapter-name filename) (chapter-name f)) (list f))) )
- filelist)))
-
-;; The library names follow a convention that allows us to extract
-;; the chapter name.
-(defun chapter-name (f)
-#+:AKCL
- (apply
- #'(lambda (s)
- (cond ((equalp (aref s 0) #\s) "s") (T (reverse (subseq s 0 3)))))
- (list (string-left-trim "a.o" (reverse f) )) )
-#+:CCL
- (subseq (string-downcase (string f)) 4 (length (string f)))
-)
-
-
(DEFUN |string2BootTree| (S)
(init-boot/spad-reader)
(LET* ((BOOT-LINE-STACK (LIST (CONS 1 S)))
@@ -773,13 +655,11 @@
(defun sourcepath (f)
"find the sourcefile in the system directories"
- (let (axiom algebra naglink)
+ (let (axiom algebra)
(setq axiom (|systemRootDirectory|))
(setq algebra (concatenate 'string axiom "/../../src/algebra/" f ".spad"))
- (setq naglink (concatenate 'string axiom "/../../src/naglink/" f ".spad"))
(cond
((probe-file algebra) algebra)
- ((probe-file naglink) naglink)
('else nil))))
(defun srcabbrevs (sourcefile)
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-03 16:45:46 +0000