diff --git a/changelog b/changelog index a84400f..f82afd1 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,7 @@ +20090901 tpd src/axiom-website/patches.html 20090901.03.tpd.patch +20090901 tpd src/interp/Makefile move nag-f01.boot to nag-f01.lisp +20090901 tpd src/interp/nag-f01.lisp added, rewritten from nag-f01.boot +20090901 tpd src/interp/nag-f01.boot removed, rewritten to nag-f01.lisp 20090901 tpd src/axiom-website/patches.html 20090901.02.tpd.patch 20090901 tpd src/interp/Makefile move nag-e04.boot to nag-e04.lisp 20090901 tpd src/interp/nag-e04.lisp added, rewritten from nag-e04.boot diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index e353d0b..76cf090 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -1962,5 +1962,7 @@ src/interp/nag-e01.lisp rewrite from boot to lisp
src/interp/nag-e02.lisp rewrite from boot to lisp
20090901.02.tpd.patch src/interp/nag-e04.lisp rewrite from boot to lisp
+20090901.03.tpd.patch +src/interp/nag-f01.lisp rewrite from boot to lisp
diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet index 2c268e1..8ddd319 100644 --- a/src/interp/Makefile.pamphlet +++ b/src/interp/Makefile.pamphlet @@ -1613,41 +1613,32 @@ ${MID}/nag-e04.lisp: ${IN}/nag-e04.lisp.pamphlet @ -\subsection{nag-f01.boot \cite{53}} +\subsection{nag-f01.lisp} <>= ${AUTO}/nag-f01.${O}: ${OUT}/nag-f01.${O} - @ echo 190 making ${AUTO}/nag-f01.${O} from ${OUT}/nag-f01.${O} + @ echo 154 making ${AUTO}/nag-f01.${O} from ${OUT}/nag-f01.${O} @ cp ${OUT}/nag-f01.${O} ${AUTO} @ <>= -${OUT}/nag-f01.${O}: ${MID}/nag-f01.clisp - @ echo 191 making ${OUT}/nag-f01.${O} from ${MID}/nag-f01.clisp - @ (cd ${MID} ; \ +${OUT}/nag-f01.${O}: ${MID}/nag-f01.lisp + @ echo 136 making ${OUT}/nag-f01.${O} from ${MID}/nag-f01.lisp + @ ( cd ${MID} ; \ if [ -z "${NOISE}" ] ; then \ - echo '(progn (compile-file "${MID}/nag-f01.clisp"' \ + echo '(progn (compile-file "${MID}/nag-f01.lisp"' \ ':output-file "${OUT}/nag-f01.${O}") (${BYE}))' | ${DEPSYS} ; \ else \ - echo '(progn (compile-file "${MID}/nag-f01.clisp"' \ + echo '(progn (compile-file "${MID}/nag-f01.lisp"' \ ':output-file "${OUT}/nag-f01.${O}") (${BYE}))' | ${DEPSYS} \ >${TMP}/trace ; \ fi ) @ -<>= -${MID}/nag-f01.clisp: ${IN}/nag-f01.boot.pamphlet - @ echo 192 making ${MID}/nag-f01.clisp from ${IN}/nag-f01.boot.pamphlet +<>= +${MID}/nag-f01.lisp: ${IN}/nag-f01.lisp.pamphlet + @ echo 137 making ${MID}/nag-f01.lisp from ${IN}/nag-f01.lisp.pamphlet @ (cd ${MID} ; \ - ${TANGLE} ${IN}/nag-f01.boot.pamphlet >nag-f01.boot ; \ - if [ -z "${NOISE}" ] ; then \ - echo '(progn (boot::reroot "${SPAD}")' \ - '(boottran::boottocl "nag-f01.boot") (${BYE}))' | ${DEPSYS} ; \ - else \ - echo '(progn (boot::reroot "${SPAD}")' \ - '(boottran::boottocl "nag-f01.boot") (${BYE}))' | ${DEPSYS} \ - >${TMP}/trace ; \ - fi ; \ - rm nag-f01.boot ) + ${TANGLE} ${IN}/nag-f01.lisp.pamphlet >nag-f01.lisp ) @ @@ -4673,7 +4664,7 @@ clean: <> <> -<> +<> <> <> diff --git a/src/interp/nag-f01.boot.pamphlet b/src/interp/nag-f01.boot.pamphlet deleted file mode 100644 index 0fa5c04..0000000 --- a/src/interp/nag-f01.boot.pamphlet +++ /dev/null @@ -1,2252 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp nag-f01.boot} -\author{The Axiom Team} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{License} -<>= --- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. --- All rights reserved. --- --- Redistribution and use in source and binary forms, with or without --- modification, are permitted provided that the following conditions are --- met: --- --- - Redistributions of source code must retain the above copyright --- notice, this list of conditions and the following disclaimer. --- --- - Redistributions in binary form must reproduce the above copyright --- notice, this list of conditions and the following disclaimer in --- the documentation and/or other materials provided with the --- distribution. --- --- - Neither the name of The Numerical ALgorithms Group Ltd. nor the --- names of its contributors may be used to endorse or promote products --- derived from this software without specific prior written permission. --- --- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS --- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED --- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A --- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER --- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, --- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, --- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR --- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF --- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING --- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS --- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - -@ -<<*>>= -<> - -f01brf() == - htInitPage("F01BRF - LU factorization of real sparse matrix",nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXf01brf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f01brf| '|NagMatrixOperationsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "Factorizes a real sparse matrix A of order n. The routine forms ") - (text . "the {\it LU} factorization of the entire matrix, or ,") - (text . "optionally, first permutes the matrix to block lower ") - (text . "triangular form and then only factorizes the diagonal block. ") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the order {\em n} of the matrix A ") - (text . "\htbitmap{great=} 1:") - (text . "\newline\tab{2} ") - (bcStrings (8 6 n PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Number of non-zero elements {\it nz}:") - (text . "\tab{32} \menuitemstyle{}\tab{34}") - (text . "{\it pivot}:") - (text . "\newline \tab{2} ") - (bcStrings (8 15 nz PI)) - (text . "\tab{34} ") - (bcStrings (8 "0.1" pivot PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Dimension of A & ICN {\it licn}:") - (text . "\tab{32} \menuitemstyle{}\tab{34}") - (text . "Dimension of IRN {\it lirn}:") - (text . "\newline \tab{2} ") - (bcStrings (6 150 licn PI)) - (text . "\tab{34} ") - (bcStrings (6 75 lirn PI)) - (text . "\blankline") - (text . "\menuitemstyle{}\tab{2} Grow value:") - (radioButtons grow - ("" " True" gr_true) - ("" " False" gr_false)) - (text . "\blankline") - (text . "\menuitemstyle{}\tab{2} Lblock value:") - (radioButtons lblock - ("" " True" lb_true) - ("" " False" lb_false)) - (text . "\blankline ") - (text . "\newline \tab{2} ") - (text . "Ifail is input in three components: ") - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "{\it a} ") - (radioButtons afail - ("" " 0, hard failure" azero) - ("" " 1, soft failure" aone)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "{\it b} ") - (radioButtons bfail - ("" " 1, print error messages" bone) - ("" " 0, suppress error messages" bzero)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "{\it c} ") - (radioButtons cfail - ("" " 1, print warning messages" cone) - ("" " 0, suppress warning messages" czero))) - htMakeDoneButton('"Continue", 'f01brfSolve) - htShowPage() - -f01brfSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - nz := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nz) - objValUnwrap htpLabelSpadValue(htPage, 'nz) - licn := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'licn) - objValUnwrap htpLabelSpadValue(htPage, 'licn) - lirn := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lirn) - objValUnwrap htpLabelSpadValue(htPage, 'lirn) - pivot := htpLabelInputString(htPage, 'pivot) - gr := htpButtonValue(htPage,'grow) - grow := - gr = 'gr_true => '"true" - '"false" - lb := htpButtonValue(htPage,'lblock) - lblock := - lb = 'lb_true => '"true" - '"false" - aerror := htpButtonValue(htPage,'afail) - afail := - aerror = 'azero => '0 - '1 - berror := htpButtonValue(htPage,'bfail) - bfail := - berror = 'bone => '1 - '0 - cerror := htpButtonValue(htPage,'cfail) - cfail := - cerror = 'cone => '1 - '0 - ifail := 100*cfail + 10*bfail + afail - ((n = '6 and nz = '15) and (licn = '150 and lirn = '75)) - => f01brfDefaultSolve(htPage,pivot,grow,lblock,ifail) - labelList := - "append"/[f(i) for i in 1..nz] where f(i) == - prefix := ('"\newline \tab{2} ") - anam := INTERN STRCONC ('"a",STRINGIMAGE i) - mid := ('"\tab{32} ") - rnam := INTERN STRCONC ('"irn",STRINGIMAGE i) - end := ('"\tab{42} ") - cnam := INTERN STRCONC ('"icn",STRINGIMAGE i) - [['text,:prefix],['bcStrings,[8, 0.0, anam, 'F]], - ['text,:mid],['bcStrings,[4, 0, rnam, 'PI]], - ['text,:end],['bcStrings,[4, 0, cnam, 'PI]]] - abortList := - [['bcStrings,[6, '"true", 'abortone, 'EM]], - ['bcStrings,[6, '"true", 'aborttwo, 'EM]], - ['bcStrings,[6, '"false", 'abortthree, 'EM]], - ['bcStrings,[6, '"true", 'abortfour, 'EM]]] - prefix := ('"\blankline \menuitemstyle{}\tab{2} Abort: ") - abortList := [['text,:prefix],:abortList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain EM (EmptyMode)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :labelList,:abortList] - page := htInitPage("F01BRF - LU factorization of real sparse matrix",nil) - htSay '"\menuitemstyle{}\tab{2} Non-zero elements of A: " - htSay '"\tab{30} \menuitemstyle{}\tab{32} Row: " - htSay '"\tab{40} \menuitemstyle{}\tab{42} Column: " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'f01brfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'nz,nz) - htpSetProperty(page,'licn,licn) - htpSetProperty(page,'lirn,lirn) - htpSetProperty(page,'pivot,pivot) - htpSetProperty(page,'grow,grow) - htpSetProperty(page,'lblock,lblock) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -f01brfDefaultSolve(htPage,pivot,grow,lblock,ifail) == - n := '6 - nz := '15 - licn := '150 - lirn := '75 - page := htInitPage("F01BRF - LU factorization of real sparse matrix",nil) - htMakePage '( - (domainConditions - (isDomain PI (Positive Integer)) - (isDomain EM $EmptyMode) - (isDomain F (Float))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Non-zero elements of A: ") - (text . "\tab{30} \menuitemstyle{}\tab{32} Row: ") - (text . "\tab{40} \menuitemstyle{}\tab{42} Column: ") - (text . "\newline \tab{2}") - (bcStrings (8 "5.0" a1 F)) - (text . "\tab{32} ") - (bcStrings (4 1 irn1 PI)) - (text . "\tab{42} ") - (bcStrings (4 1 icn1 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "2.0" a2 F)) - (text . "\tab{32} ") - (bcStrings (4 2 irn2 PI)) - (text . "\tab{42} ") - (bcStrings (4 2 icn2 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "-1.0" a3 F)) - (text . "\tab{32} ") - (bcStrings (4 2 irn3 PI)) - (text . "\tab{42} ") - (bcStrings (4 3 icn3 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "2.0" a4 F)) - (text . "\tab{32} ") - (bcStrings (4 2 irn4 PI)) - (text . "\tab{42} ") - (bcStrings (4 4 icn4 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "3.0" a5 F)) - (text . "\tab{32} ") - (bcStrings (4 3 irn5 PI)) - (text . "\tab{42} ") - (bcStrings (4 3 icn5 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "-2.0" a6 F)) - (text . "\tab{32} ") - (bcStrings (4 4 irn6 PI)) - (text . "\tab{42} ") - (bcStrings (4 1 icn6 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "1.0" a7 F)) - (text . "\tab{32} ") - (bcStrings (4 4 irn7 PI)) - (text . "\tab{42} ") - (bcStrings (4 4 icn7 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "1.0" a8 F)) - (text . "\tab{32} ") - (bcStrings (4 4 irn8 PI)) - (text . "\tab{42} ") - (bcStrings (4 5 icn8 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "-1.0" a9 F)) - (text . "\tab{32} ") - (bcStrings (4 5 irn9 PI)) - (text . "\tab{42} ") - (bcStrings (4 1 icn9 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "-1.0" a10 F)) - (text . "\tab{32} ") - (bcStrings (4 5 irn10 PI)) - (text . "\tab{42} ") - (bcStrings (4 4 icn10 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "2.0" a11 F)) - (text . "\tab{32} ") - (bcStrings (4 5 irn11 PI)) - (text . "\tab{42} ") - (bcStrings (4 5 icn11 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "-3.0" a12 F)) - (text . "\tab{32} ") - (bcStrings (4 5 irn12 PI)) - (text . "\tab{42} ") - (bcStrings (4 6 icn12 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "-1.0" a13 F)) - (text . "\tab{32} ") - (bcStrings (4 6 irn13 PI)) - (text . "\tab{42} ") - (bcStrings (4 1 icn13 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "-1.0" a14 F)) - (text . "\tab{32} ") - (bcStrings (4 6 irn14 PI)) - (text . "\tab{42} ") - (bcStrings (4 2 icn14 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "6.0" a15 F)) - (text . "\tab{32} ") - (bcStrings (4 6 irn15 PI)) - (text . "\tab{42} ") - (bcStrings (4 6 icn15 PI)) - (text . "\blankline ") - (text . "\menuitemstyle{} \tab{2} Abort :") - (bcStrings (8 "true" abort_one EM)) - (bcStrings (8 "true" abort_two EM)) - (bcStrings (8 "false" abort_three EM)) - (bcStrings (8 "true" abort_four EM))) - htMakeDoneButton('"Continue",'f01brfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'nz,nz) - htpSetProperty(page,'licn,licn) - htpSetProperty(page,'lirn,lirn) - htpSetProperty(page,'pivot,pivot) - htpSetProperty(page,'grow,grow) - htpSetProperty(page,'lblock,lblock) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f01brfGen htPage == - n := htpProperty(htPage,'n) - nz := htpProperty(htPage,'nz) - licn := htpProperty(htPage,'licn) - lirn := htpProperty(htPage,'lirn) - pivot := htpProperty(htPage,'pivot) - grow := htpProperty(htPage,'grow) - lblock := htpProperty(htPage,'lblock) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - for i in 1..4 repeat - abort := STRCONC((first y).1," ") - y := rest y - abortList := [abort,:abortList] - astring := bcwords2liststring abortList - while y repeat - end := STRCONC ((first y).1," ") - y := rest y - mid := STRCONC ((first y).1," ") - y := rest y - top := STRCONC ((first y).1," ") - y := rest y - cList := [end,:cList] - rList := [mid,:rList] - matList := [top,:matList] - for i in 1..(licn-nz) repeat - cList := [:cList,'"0 "] - matList := [:matList,'"0 "] - for i in 1..(lirn-nz) repeat - rList := [:rList,'"0 "] - cstring := bcwords2liststring cList - rstring := bcwords2liststring rList - matstring := bcwords2liststring matList - prefix := STRCONC('"f01brf(",STRINGIMAGE n,", ",STRINGIMAGE nz,", ") - prefix := STRCONC(prefix,STRINGIMAGE licn,", ",STRINGIMAGE lirn,", ",pivot) - prefix := STRCONC(prefix,", ",lblock,", ",grow,", ",astring,",[",matstring) - prefix := STRCONC(prefix,"],[",rstring,"],[",cstring,"], ") - linkGen STRCONC(prefix,STRINGIMAGE ifail,")") - -f01bsf() == - htInitPage("F01BSF - LU factorization of real sparse matrix with known sparsity pattern",nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXf01bsf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f01bsf| '|NagMatrixOperationsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "Factorizes a real sparse matrix A of order n using the pivotal ") - (text . "sequence previously obtained by F01BRF when a matrix of the ") - (text . "same sparsity pattern was factorized. ") - (text . "\blankline ") - (text . "Read the input file to see the example program. ") - (text . "\spadpaste{)read f01bsf \bound{s0}} ") - (text . "\blankline") - (text . "\newline ")) - htShowPage() - -f01maf() == - htInitPage("F01MAF - \htbitmap{llt} factorization of real sparse symmetric positive-definite matrix",nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXf01maf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f01maf| '|NagMatrixOperationsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "Computes an incomplete Cholesky factorization of a real ") - (text . "sparse symmetric positive-definite matrix A of order n. ") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the order {\em n} of the matrix A ") - (text . "\htbitmap{great=} 1:") - (text . "\newline\tab{2} ") - (bcStrings (8 16 n PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Number of non-zero elements {\it nz}:") - (text . "\newline \tab{2} ") - (bcStrings (8 40 nz PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Dimension of A & ICN {\it licn}:") - (text . "\tab{32} \menuitemstyle{}\tab{34}") - (text . "Dimension of IRN {\it lirn}:") - (text . "\newline \tab{2} ") - (bcStrings (6 90 licn PI)) - (text . "\tab{34} ") - (bcStrings (6 50 lirn PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Tolerance {\it droptl}: ") - (text . "\tab{32} \menuitemstyle{}\tab{34}") - (text . "{\it densw}:") - (text . "\newline \tab{2} ") - (bcStrings (6 "0.1" droptl F)) - (text . "\tab{34} ") - (bcStrings (6 "0.8" densw F)) - (text . "\blankline ") - (text . "\newline \tab{2} ") - (text . "Ifail is input in three components: ") - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "{\it a} ") - (radioButtons afail - ("" " 0, hard failure" azero) - ("" " 1, soft failure" aone)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "{\it b} ") - (radioButtons bfail - ("" " 1, print error messages" bone) - ("" " 0, suppress error messages" bzero)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "{\it c} ") - (radioButtons cfail - ("" " 1, print warning messages" cone) - ("" " 0, suppress warning messages" czero))) - htMakeDoneButton('"Continue", 'f01mafSolve) - htShowPage() - -f01mafSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - nz := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nz) - objValUnwrap htpLabelSpadValue(htPage, 'nz) - licn := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'licn) - objValUnwrap htpLabelSpadValue(htPage, 'licn) - lirn := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lirn) - objValUnwrap htpLabelSpadValue(htPage, 'lirn) - aerror := htpButtonValue(htPage,'afail) - afail := - aerror = 'azero => '0 - '1 - berror := htpButtonValue(htPage,'bfail) - bfail := - berror = 'bone => '1 - '0 - cerror := htpButtonValue(htPage,'cfail) - cfail := - cerror = 'cone => '1 - '0 - ifail := 100*cfail + 10*bfail + afail - droptl := htpLabelInputString(htPage, 'droptl) - densw := htpLabelInputString(htPage, 'densw) - ((n = '16 and nz = '40) and (licn = '90 and lirn = '50)) - => f01mafDefaultSolve(htPage,droptl,densw,ifail) - labelList := - "append"/[f(i) for i in 1..nz] where f(i) == - prefix := ('"\newline \tab{2} ") - anam := INTERN STRCONC ('"a",STRINGIMAGE i) - mid := ('"\tab{32} ") - rnam := INTERN STRCONC ('"irn",STRINGIMAGE i) - end := ('"\tab{42} ") - cnam := INTERN STRCONC ('"icn",STRINGIMAGE i) - [['text,:prefix],['bcStrings,[8, 0.0, anam, 'F]], - ['text,:mid],['bcStrings,[4, 0, rnam, 'PI]], - ['text,:end],['bcStrings,[4, 0, cnam, 'PI]]] - abortList := - [['bcStrings,[6, '"true", 'abortone, 'EM]], - ['bcStrings,[6, '"true", 'aborttwo, 'EM]], - ['bcStrings,[6, '"true", 'abortthree, 'EM]]] - prefix := ('"\blankline \menuitemstyle{}\tab{2} Abort: ") - abortList := [['text,:prefix],:abortList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain EM (EmptyMode)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :labelList,:abortList] - page := htInitPage("F01MAF - \htbitmap{llt} factorization of real sparse symmetric positive-definite matrix",nil) - htSay '"\menuitemstyle{}\tab{2} Non-zero elements of A: " - htSay '"\tab{30} \menuitemstyle{}\tab{32} Row: " - htSay '"\tab{40} \menuitemstyle{}\tab{42} Column: " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'f01mafGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'nz,nz) - htpSetProperty(page,'licn,licn) - htpSetProperty(page,'lirn,lirn) - htpSetProperty(page,'droptl,droptl) - htpSetProperty(page,'densw,densw) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -f01mafDefaultSolve(htPage,droptl,densw,ifail) == - n := '16 - nz := '40 - licn := '90 - lirn := '50 - page := htInitPage("F01MAF - \htbitmap{llt} factorization of real sparse symmetric positive-definite matrix",nil) - htMakePage '( - (domainConditions - (isDomain PI (Positive Integer)) - (isDomain EM $EmptyMode) - (isDomain F (Float))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Non-zero elements of A: ") - (text . "\tab{30} \menuitemstyle{}\tab{32} Row: ") - (text . "\tab{40} \menuitemstyle{}\tab{42} Column: ") - (text . "\newline \tab{2}") - (bcStrings (8 "1.0" a1 F)) - (text . "\tab{32} ") - (bcStrings (4 1 irn1 PI)) - (text . "\tab{42} ") - (bcStrings (4 1 icn1 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "1.0" a2 F)) - (text . "\tab{32} ") - (bcStrings (4 2 irn2 PI)) - (text . "\tab{42} ") - (bcStrings (4 2 icn2 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "1.0" a3 F)) - (text . "\tab{32} ") - (bcStrings (4 3 irn3 PI)) - (text . "\tab{42} ") - (bcStrings (4 3 icn3 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "1.0" a4 F)) - (text . "\tab{32} ") - (bcStrings (4 4 irn4 PI)) - (text . "\tab{42} ") - (bcStrings (4 4 icn4 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "1.0" a5 F)) - (text . "\tab{32} ") - (bcStrings (4 5 irn5 PI)) - (text . "\tab{42} ") - (bcStrings (4 5 icn5 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "1.0" a6 F)) - (text . "\tab{32} ") - (bcStrings (4 6 irn6 PI)) - (text . "\tab{42} ") - (bcStrings (4 6 icn6 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "1.0" a7 F)) - (text . "\tab{32} ") - (bcStrings (4 7 irn7 PI)) - (text . "\tab{42} ") - (bcStrings (4 7 icn7 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "1.0" a8 F)) - (text . "\tab{32} ") - (bcStrings (4 8 irn8 PI)) - (text . "\tab{42} ") - (bcStrings (4 8 icn8 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "1.0" a9 F)) - (text . "\tab{32} ") - (bcStrings (4 9 irn9 PI)) - (text . "\tab{42} ") - (bcStrings (4 9 icn9 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "1.0" a10 F)) - (text . "\tab{32} ") - (bcStrings (4 10 irn10 PI)) - (text . "\tab{42} ") - (bcStrings (4 10 icn10 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "1.0" a11 F)) - (text . "\tab{32} ") - (bcStrings (4 11 irn11 PI)) - (text . "\tab{42} ") - (bcStrings (4 11 icn11 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "1.0" a12 F)) - (text . "\tab{32} ") - (bcStrings (4 12 irn12 PI)) - (text . "\tab{42} ") - (bcStrings (4 12 icn12 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "1.0" a13 F)) - (text . "\tab{32} ") - (bcStrings (4 13 irn13 PI)) - (text . "\tab{42} ") - (bcStrings (4 13 icn13 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "1.0" a14 F)) - (text . "\tab{32} ") - (bcStrings (4 14 irn14 PI)) - (text . "\tab{42} ") - (bcStrings (4 14 icn14 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "1.0" a15 F)) - (text . "\tab{32} ") - (bcStrings (4 15 irn15 PI)) - (text . "\tab{42} ") - (bcStrings (4 15 icn15 PI)) - (text . "\blankline ") - (text . "\newline \tab{2}") - (bcStrings (8 "1.0" a16 F)) - (text . "\tab{32} ") - (bcStrings (4 16 irn16 PI)) - (text . "\tab{42} ") - (bcStrings (4 16 icn16 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "-0.25" a17 F)) - (text . "\tab{32} ") - (bcStrings (4 1 irn17 PI)) - (text . "\tab{42} ") - (bcStrings (4 2 icn17 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "-0.25" a18 F)) - (text . "\tab{32} ") - (bcStrings (4 2 irn18 PI)) - (text . "\tab{42} ") - (bcStrings (4 3 icn18 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "-0.25" a19 F)) - (text . "\tab{32} ") - (bcStrings (4 3 irn19 PI)) - (text . "\tab{42} ") - (bcStrings (4 4 icn19 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "-0.25" a20 F)) - (text . "\tab{32} ") - (bcStrings (4 5 irn20 PI)) - (text . "\tab{42} ") - (bcStrings (4 6 icn20 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "-0.25" a21 F)) - (text . "\tab{32} ") - (bcStrings (4 6 irn21 PI)) - (text . "\tab{42} ") - (bcStrings (4 7 icn21 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "-0.25" a22 F)) - (text . "\tab{32} ") - (bcStrings (4 7 irn22 PI)) - (text . "\tab{42} ") - (bcStrings (4 8 icn22 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "-0.25" a23 F)) - (text . "\tab{32} ") - (bcStrings (4 9 irn23 PI)) - (text . "\tab{42} ") - (bcStrings (4 10 icn23 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "-0.25" a24 F)) - (text . "\tab{32} ") - (bcStrings (4 10 irn24 PI)) - (text . "\tab{42} ") - (bcStrings (4 11 icn24 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "-0.25" a25 F)) - (text . "\tab{32} ") - (bcStrings (4 11 irn25 PI)) - (text . "\tab{42} ") - (bcStrings (4 12 icn25 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "-0.25" a26 F)) - (text . "\tab{32} ") - (bcStrings (4 13 irn26 PI)) - (text . "\tab{42} ") - (bcStrings (4 14 icn26 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "-0.25" a27 F)) - (text . "\tab{32} ") - (bcStrings (4 14 irn27 PI)) - (text . "\tab{42} ") - (bcStrings (4 15 icn27 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "-0.25" a28 F)) - (text . "\tab{32} ") - (bcStrings (4 15 irn28 PI)) - (text . "\tab{42} ") - (bcStrings (4 16 icn28 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "-0.25" a29 F)) - (text . "\tab{32} ") - (bcStrings (4 1 irn29 PI)) - (text . "\tab{42} ") - (bcStrings (4 5 icn29 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "-0.25" a30 F)) - (text . "\tab{32} ") - (bcStrings (4 2 irn30 PI)) - (text . "\tab{42} ") - (bcStrings (4 6 icn30 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "-0.25" a31 F)) - (text . "\tab{32} ") - (bcStrings (4 3 irn31 PI)) - (text . "\tab{42} ") - (bcStrings (4 7 icn31 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "-0.25" a32 F)) - (text . "\tab{32} ") - (bcStrings (4 4 irn32 PI)) - (text . "\tab{42} ") - (bcStrings (4 8 icn32 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "-0.25" a33 F)) - (text . "\tab{32} ") - (bcStrings (4 5 irn33 PI)) - (text . "\tab{42} ") - (bcStrings (4 9 icn33 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "-0.25" a34 F)) - (text . "\tab{32} ") - (bcStrings (4 6 irn34 PI)) - (text . "\tab{42} ") - (bcStrings (4 10 icn34 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "-0.25" a35 F)) - (text . "\tab{32} ") - (bcStrings (4 7 irn35 PI)) - (text . "\tab{42} ") - (bcStrings (4 11 icn35 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "-0.25" a36 F)) - (text . "\tab{32} ") - (bcStrings (4 8 irn36 PI)) - (text . "\tab{42} ") - (bcStrings (4 12 icn36 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "-0.25" a37 F)) - (text . "\tab{32} ") - (bcStrings (4 9 irn37 PI)) - (text . "\tab{42} ") - (bcStrings (4 13 icn37 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "-0.25" a38 F)) - (text . "\tab{32} ") - (bcStrings (4 10 irn38 PI)) - (text . "\tab{42} ") - (bcStrings (4 14 icn38 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "-0.25" a39 F)) - (text . "\tab{32} ") - (bcStrings (4 11 irn39 PI)) - (text . "\tab{42} ") - (bcStrings (4 15 icn39 PI)) - (text . "\newline \tab{2}") - (bcStrings (8 "-0.25" a40 F)) - (text . "\tab{32} ") - (bcStrings (4 12 irn40 PI)) - (text . "\tab{42} ") - (bcStrings (4 16 icn40 PI)) - (text . "\blankline ") - (text . "\menuitemstyle{} \tab{2} Abort :") - (bcStrings (8 "true" abort_one EM)) - (bcStrings (8 "true" abort_two EM)) - (bcStrings (8 "true" abort_three EM))) - htMakeDoneButton('"Continue",'f01mafGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'nz,nz) - htpSetProperty(page,'licn,licn) - htpSetProperty(page,'lirn,lirn) - htpSetProperty(page,'droptl,droptl) - htpSetProperty(page,'densw,densw) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f01mafGen htPage == - n := htpProperty(htPage,'n) - nz := htpProperty(htPage,'nz) - licn := htpProperty(htPage,'licn) - lirn := htpProperty(htPage,'lirn) - droptl := htpProperty(htPage,'droptl) - densw := htpProperty(htPage,'densw) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - for i in 1..3 repeat - abort := STRCONC((first y).1," ") - y := rest y - abortList := [abort,:abortList] - astring := bcwords2liststring abortList - while y repeat - end := STRCONC ((first y).1," ") - y := rest y - mid := STRCONC ((first y).1," ") - y := rest y - top := STRCONC ((first y).1," ") - y := rest y - cList := [end,:cList] - rList := [mid,:rList] - matList := [top,:matList] - for i in 1..(licn-nz) repeat - cList := [:cList,'"0 "] - matList := [:matList,'"0 "] - for i in 1..(lirn-nz) repeat - rList := [:rList,'"0 "] - cstring := bcwords2liststring cList - rstring := bcwords2liststring rList - matstring := bcwords2liststring matList - prefix := STRCONC('"f01maf(",STRINGIMAGE n,", ",STRINGIMAGE nz,", ") - prefix := STRCONC(prefix,STRINGIMAGE licn,", ",STRINGIMAGE lirn,", ") - prefix := STRCONC(prefix,astring,",[",matstring) - prefix := STRCONC(prefix,"],[",rstring,"],[",cstring,"], ",droptl,", ",densw) - linkGen STRCONC(prefix,", ",STRINGIMAGE ifail,")") - - - - -f01mcf() == - htInitPage("F01MCF - \htbitmap{ldlt} factorization of real symmetric positive-definite variable-bandwidth matrix",nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXf01mcf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f01mcf| '|NagMatrixOperationsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "Computes the Cholesky factorization of a real symmetric positive") - (text . "-definite variable-bandwidth matrix {\it A} or order {\it n}. ") - (text . "That is, {\it A = }\htbitmap{ldlt}, where {\it L} is ") - (text . "a unit lower triangular matrix and {\it D} is a diagonal matrix.") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the order {\em n} of the matrix A ") - (text . "\htbitmap{great=} 1:") - (text . "\newline\tab{2} ") - (bcStrings (9 6 n PI)) - (text . "\blankline") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "\newline Enter the number of elements: ") - (text . "\newline\tab{2} ") - (bcStrings (9 14 lal PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Ifail value:") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'f01mcfSolve) - htShowPage() - -f01mcfSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - lal := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lal) - objValUnwrap htpLabelSpadValue(htPage, 'lal) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - (n = '6 and lal = '14) => f01mcfDefaultSolve(htPage,ifail) - labelList := - "append"/[f(i) for i in 1..lal] where f(i) == - xnam := INTERN STRCONC ('"x",STRINGIMAGE i) - [['bcStrings,[6, 0.0, xnam, 'F]]] - nrowList := - "append"/[g(j) for j in 1..n] where g(j) == - nam := INTERN STRCONC ('"n",STRINGIMAGE j) - [['bcStrings,[6, 0, nam, 'PI]]] - prefix := ('"\blankline \menuitemstyle{}\tab{2} {\it NROW(n)} the width ") - prefix := STRCONC(prefix,"of the ith row of A: \newline \tab{2} ") - nrowList := [['text,:prefix],:nrowList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :labelList,:nrowList] - page := htInitPage("F01MCF - \htbitmap{ldlt} factorization of real symmetric positive-definite variable-bandwidth matrix",nil) - htSay '"\menuitemstyle{}\tab{2} Elements of matrix {\it A} in row by row " - htSay '"order: \newline \tab{2} " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'f01mcfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'lal,lal) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -f01mcfDefaultSolve (htPage,ifail) == - n := '6 - lal := '14 - page := htInitPage("F01MCF - \htbitmap{ldlt} factorization of real symmetric positive-definite variable-bandwidth matrix",nil) - htMakePage '( - (domainConditions - (isDomain PI (Positive Integer)) - (isDomain F (Float))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Elements of matrix {\it A} in row by ") - (text . "row order: ") - (text . "\newline ") - (bcStrings (6 "1.0" x1 F)) - (bcStrings (6 "2.0" x2 F)) - (bcStrings (6 "5.0" x3 F)) - (bcStrings (6 "3.0" x4 F)) - (bcStrings (6 "13.0" x5 F)) - (bcStrings (6 "16.0" x6 F)) - (bcStrings (6 "5.0" x7 F)) - (bcStrings (6 "14.0" x8 F)) - (bcStrings (6 "18.0" x9 F)) - (bcStrings (6 "8.0" x10 F)) - (bcStrings (6 "55.0" x11 F)) - (bcStrings (6 "24.0" x12 F)) - (bcStrings (6 "17.0" x13 F)) - (bcStrings (6 "77.0" x14 F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} {\it NROW(n)} the width of the ith row ") - (text . "of A: ") - (text . "\newline ") - (bcStrings (6 1 n1 PI)) - (bcStrings (6 2 n2 PI)) - (bcStrings (6 2 n3 PI)) - (bcStrings (6 1 n4 PI)) - (bcStrings (6 5 n5 PI)) - (bcStrings (6 3 n6 PI)) - (text . "\blankline ")) - htMakeDoneButton('"Continue",'f01mcfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'lal,lal) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f01mcfGen htPage == - n := htpProperty(htPage,'n) - lal := htpProperty(htPage,'lal) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - for i in 1..n repeat - right := STRCONC ((first y).1," ") - y := rest y - nrowList := [right,:nrowList] - nrowstring := bcwords2liststring nrowList - while y repeat - right := STRCONC ((first y).1," ") - y := rest y - matList := [right,:matList] - matstring := bcwords2liststring matList - prefix := STRCONC('"f01mcf(",STRINGIMAGE n,", [",matstring,"], ") - prefix := STRCONC(prefix,STRINGIMAGE lal,", [",nrowstring,"], ") - linkGen STRCONC(prefix,STRINGIMAGE ifail,")") - - -f01qcf() == - htInitPage('"F01QCF - QR factorization or real m by n matrix (m \htbitmap{great=} n)",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXf01qcf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f01qcf| '|NagMatrixOperationsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "Finds the QR factorization of a real {\it m} by {it n} ({\it m ") - (text . "\htbitmap{great=} n}) matrix {\it A}, which ") - (text . "is factorized as \htbitmap{f01qcf}, ") - (text . "where {\it m > n} and {\it A = QR } when {\it m = n }, where ") - (text . "{\it Q} is an {\it m} by {\it m } orthogonal matrix and {\it R} ") - (text . "is an {\it n} by {\it n} upper triangular matrix. The {\it k}th ") - (text . "transformation matrix,{\it Qk}, ") - (text . "which is used to introduce zeros into the {\it k}th column of ") - (text . "{\it A}, is given in the form ") - (text . "\htbitmap{f01qcf1}, ") - (text . "where \htbitmap{f01qcf2}, ") - (text . "\htbitmap{f01qcf3}, ") - (text . "\htbitmap{zetak} is a scalar and ") - (text . "\htbitmap{zk} is an (m-k) element vector. ") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline Rows of matrix A, {\it m}: ") - (text . "\tab{32} \menuitemstyle{} \tab{34} ") - (text . "Columns of matrix A, {\it n}: \newline \tab{2} ") - (bcStrings (6 5 m PI)) - (text . "\tab{34} ") - (bcStrings (6 3 n PI)) --- (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{} \tab{2} ") --- (text . "\newline First dimension of A, {\it lda} ") --- (text . "\htbitmap{great=} m: ") --- (text . "\newline \tab{2} ") --- (bcStrings (6 5 lda PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'f01qcfSolve) - htShowPage() - -f01qcfSolve htPage == - m := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) - objValUnwrap htpLabelSpadValue(htPage, 'm) - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - lda := m --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lda) --- objValUnwrap htpLabelSpadValue(htPage, 'lda) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - (m = '5 and n = '3) => f01qcfDefaultSolve(htPage,lda,ifail) - matList := - "append"/[f(i,n) for i in 1..lda] where f(i,n) == - labelList := - "append"/[g(i,j) for j in 1..n] where g(i,j) == - anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) - [['bcStrings,[6, "0.0", anam, 'F]]] - prefix := ('"\newline \tab{2} ") - labelList := [['text,:prefix],:labelList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :matList] - page := htInitPage("F01QCF - QR factorization or real m by n matrix (m \htbitmap{great=} n)",nil) - htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " - htSay '"\newline \tab{2} " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'f01qcfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) --- htpSetProperty(page,'lda,lda) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -f01qcfDefaultSolve (htPage,lda,ifail) == - n := '3 - m := '5 - page := htInitPage('"F01QCF - QR factorization or real m by n matrix (m \htbitmap{great=} n)",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 "2.0" a11 F)) - (bcStrings (6 "2.5" a12 F)) - (bcStrings (6 "2.5" a13 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "2.0" a21 F)) - (bcStrings (6 "2.5" a22 F)) - (bcStrings (6 "2.5" a23 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "1.6" a31 F)) - (bcStrings (6 "-0.4" a32 F)) - (bcStrings (6 "2.8" a33 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "2.0" a41 F)) - (bcStrings (6 "-0.5" a42 F)) - (bcStrings (6 "0.5" a43 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "1.2" a51 F)) - (bcStrings (6 "-0.3" a52 F)) - (bcStrings (6 "-2.9" a53 F))) - htMakeDoneButton('"Continue",'f01qcfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) --- htpSetProperty(page,'lda,lda) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f01qcfGen htPage == - n := htpProperty(htPage,'n) - m := htpProperty(htPage,'m) --- lda := htpProperty(htPage,'lda) - lda := m - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - y := REVERSE y - for i in 1..lda repeat - for j in 1..n repeat - elm := STRCONC((first y).1," ") - rowList := [:rowList,elm] - y := rest y - matform := [:matform,rowList] - rowList := [] - matstring := bcwords2liststring [bcwords2liststring x for x in matform] - prefix := STRCONC('"f01qcf(",STRINGIMAGE m,", ",STRINGIMAGE n,", ") - prefix := STRCONC(prefix,STRINGIMAGE lda,", ",matstring,", ") - prefix := STRCONC(prefix,STRINGIMAGE ifail,")") - linkGen prefix - -f01qdf() == - htInitPage('"F01QDF - Operations with orthogonal matrices, compute {\it QB} or \htbitmap{f01qdf} after factorization by F01QCF or F01QDF",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXf01qdf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f01qdf| '|NagMatrixOperationsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "Performs one of the transformations {\it B = QB or B = }") - (text . "\htbitmap{f01qdf}, where {\it B} is a real {\it m} ") - (text . "by {\it ncolb} matrix and {\it Q} is an {\it m} by {\it m} ") - (text . "orthogonal matrix assumed to be given by {\it Q = }") - (text . "\htbitmap{f01qdf1}, \htbitmap{f01qdf2} ") - (text . "being given in the form ") - (text . "\htbitmap{f01qcf1}, ") - (text . "where \htbitmap{f01qcf2}, ") - (text . "\htbitmap{f01qcf3}, ") - (text . "\htbitmap{zetak} is a scalar and ") - (text . "\htbitmap{zk} is an (m-k) element vector. ") - (text . "The routine is intended for use following F01QCF or F01QFF. ") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline Rows of matrix A, {\it m}: ") - (text . "\tab{32} \menuitemstyle{} \tab{34} ") - (text . "Columns of matrix A, {\it n}: \newline \tab{2} ") - (bcStrings (6 5 m PI)) - (text . "\tab{34} ") - (bcStrings (6 3 n PI)) --- (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{} \tab{2} ") --- (text . "\newline First dimension of A, {\it lda} ") --- (text . "\htbitmap{great=} m: ") --- (text . "\tab{32} \menuitemstyle{} \tab{34} ") --- (text . "First dimension of B, {\it ldb} ") --- (text . "\htbitmap{great=} m: ") --- (text . "\newline \tab{2} ") --- (bcStrings (6 5 lda PI)) --- (text . "\tab{34} ") --- (bcStrings (6 5 ldb PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Number of columns of matrix B {\it ncolb}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 2 ncolb PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Transformation to be performed: ") - (radioButtons trans - (" " " {\it B = QB}" no_trans) - (" " " {\it B =} \htbitmap{f01qdf}" trans)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Where the elements can be found: ") - (radioButtons wheret - (" " " the elements of \zeta are in A" in_a) - (" " " the elements of \zeta are in ZETA, returned by F01QCF/F01QFF" seperate)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'f01qdfSolve) - htShowPage() - -f01qdfSolve htPage == - m := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) - objValUnwrap htpLabelSpadValue(htPage, 'm) - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - lda := m --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lda) --- objValUnwrap htpLabelSpadValue(htPage, 'lda) - ldb := m --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ldb) --- objValUnwrap htpLabelSpadValue(htPage, 'ldb) - ncolb := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ncolb) - objValUnwrap htpLabelSpadValue(htPage, 'ncolb) - operation := htpButtonValue(htPage,'trans) - trans := - operation = 'no_trans => '"n" - '"t" - elements := htpButtonValue(htPage,'wheret) - wheret := - elements = 'in_a => '"i" - '"s" - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - ((m = '5 and n = '3) and ncolb = '2) => f01qdfDefaultSolve(htPage,lda,ldb,trans,wheret,ifail) - matList := - "append"/[fa(i,n) for i in 1..lda] where fa(i,n) == - labelList := - "append"/[ga(i,j) for j in 1..n] where ga(i,j) == - anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) - [['bcStrings,[6, "0.0", anam, 'F]]] - prefix := ('"\newline \tab{2} ") - labelList := [['text,:prefix],:labelList] - bList := - "append"/[fb(i,ncolb) for i in 1..ldb] where fb(i,ncolb) == - labelList := - "append"/[gb(i,j) for j in 1..ncolb] where gb(i,j) == - bnam := INTERN STRCONC ('"b",STRINGIMAGE i, STRINGIMAGE j) - [['bcStrings,[6, "0.0", bnam, 'F]]] - prefix := ('"\newline \tab{2} ") - labelList := [['text,:prefix],:labelList] - prefix := ("\blankline \menuitemstyle{}\tab{2} Enter values of {\it B}: ") - bList := [['text,:prefix],:bList] - zList := - "append"/[fz(i) for i in 1..n] where fz(i) == - znam := INTERN STRCONC ('"z",STRINGIMAGE i) - [['bcStrings,[6, "0.0", znam, 'F]]] - prefix := ("\blankline \menuitemstyle{}\tab{2} Enter values of \zeta ") - prefix := STRCONC(prefix,"(if required): \newline \tab{2}") - zList := [['text,:prefix],:zList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :matList,:bList,:zList] - page := htInitPage('"F01QDF - Operations with orthogonal matrices, compute {\it QB} or \htbitmap{f01qdf} after factorization by F01QCF or F01QDF",nil) - htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " - htSay '"\newline \tab{2} " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'f01qdfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) --- htpSetProperty(page,'lda,lda) --- htpSetProperty(page,'ldb,ldb) - htpSetProperty(page,'ncolb,ncolb) - htpSetProperty(page,'trans,trans) - htpSetProperty(page,'wheret,wheret) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -f01qdfDefaultSolve (htPage,lda,ldb,trans,wheret,ifail) == - n := '3 - m := '5 - ncolb := '2 - page := htInitPage('"F01QDF - Operations with orthogonal matrices, compute {\it QB} or \htbitmap{f01qdf} after factorization by F01QCF or F01QDF",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 "2.0" a11 F)) - (bcStrings (6 "2.5" a12 F)) - (bcStrings (6 "2.5" a13 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "2.0" a21 F)) - (bcStrings (6 "2.5" a22 F)) - (bcStrings (6 "2.5" a23 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "1.6" a31 F)) - (bcStrings (6 "-0.4" a32 F)) - (bcStrings (6 "2.8" a33 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "2.0" a41 F)) - (bcStrings (6 "-0.5" a42 F)) - (bcStrings (6 "0.5" a43 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "1.2" a51 F)) - (bcStrings (6 "-0.3" a52 F)) - (bcStrings (6 "-2.9" a53 F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} Enter values of {\it B}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 "1.1" b11 F)) - (bcStrings (6 "0.0" b12 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.9" b21 F)) - (bcStrings (6 "0.0" b22 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.6" b31 F)) - (bcStrings (6 "1.32" b32 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" b41 F)) - (bcStrings (6 "1.1" b42 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "-0.8" b51 F)) - (bcStrings (6 "-0.26" b52 F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter values of \zeta (if required): ") - (text . "\newline \tab{2} ") - (bcStrings (10 "0.0" z1 F)) - (bcStrings (10 "0.0" z2 F)) - (bcStrings (10 "0.0" z3 F)) - (text . "\blankline ")) - htMakeDoneButton('"Continue",'f01qdfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) --- htpSetProperty(page,'lda,lda) --- htpSetProperty(page,'ldb,ldb) - htpSetProperty(page,'ncolb,ncolb) - htpSetProperty(page,'trans,trans) - htpSetProperty(page,'wheret,wheret) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f01qdfGen htPage == - n := htpProperty(htPage,'n) - m := htpProperty(htPage,'m) --- lda := htpProperty(htPage,'lda) --- ldb := htpProperty(htPage,'ldb) - lda := m - ldb := m - ncolb := htpProperty(htPage,'ncolb) - trans := htpProperty(htPage,'trans) - wheret := htpProperty(htPage,'wheret) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - for i in 1..n repeat - left := STRCONC((first y).1," ") - y := rest y - zetalist := [left,:zetalist] - zetastring := bcwords2liststring zetalist - y := REVERSE y - for i in 1..lda repeat - for j in 1..n repeat - elm := STRCONC((first y).1," ") - rowList := [:rowList,elm] - y := rest y - matform := [:matform,rowList] - rowList := [] - matstring := bcwords2liststring [bcwords2liststring x for x in matform] - for i in 1..ldb repeat - for j in 1..ncolb repeat - elm := STRCONC((first y).1," ") - rowList := [:rowList,elm] - y := rest y - bform := [:bform,rowList] - rowList := [] - bstring := bcwords2liststring [bcwords2liststring x for x in bform] - prefix := STRCONC('"f01qdf(_"",trans,"_",_"",wheret,"_",",STRINGIMAGE m,", ") - prefix := STRCONC(prefix,STRINGIMAGE n,", ",matstring,", ",STRINGIMAGE lda) - prefix := STRCONC(prefix,",[",zetastring,"],",STRINGIMAGE ncolb,", ") - prefix := STRCONC(prefix,STRINGIMAGE ldb,", ",bstring,", ",STRINGIMAGE ifail,")") - linkGen prefix - - -f01qef() == - htInitPage('"F01QEF - Operations with orthogonal matrices, form columns of {\it Q} after factorization by F01QCF or F01QFF",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXf01qef} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f01qef| '|NagMatrixOperationsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "Returns the first {\it ncolq} columns of the real {\it m} by ") - (text . "{\it n} orthogonal matrix {\it Q}, where {\it Q} is assumed ") - (text . "to be given by {\it Q = }\htbitmap{f01qdf1}, ") - (text . "\htbitmap{f01qdf2} being given in the form ") - (text . "\htbitmap{f01qcf1}, ") - (text . "where \htbitmap{f01qcf2}, ") - (text . "\htbitmap{f01qcf3}, ") - (text . "\htbitmap{zetak} is a scalar and ") - (text . "\htbitmap{zk} is an (m-k) element vector. ") - (text . "The routine is intended for use following F01QCF or F01QFF. ") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline Rows of matrix A, {\it m}: ") - (text . "\tab{32} \menuitemstyle{} \tab{34} ") - (text . "Columns of matrix A, {\it n}: \newline \tab{2} ") - (bcStrings (6 5 m PI)) - (text . "\tab{34} ") - (bcStrings (6 3 n PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") --- (text . "\newline First dimension of A, {\it lda} ") --- (text . "\htbitmap{great=} m: ") --- (text . "\tab{32} \menuitemstyle{} \tab{34} ") - (text . "Number columns of matrix Q {\it ncolq}: ") - (text . "\newline \tab{2} ") --- (bcStrings (6 5 lda PI)) --- (text . "\tab{34} ") - (bcStrings (6 5 ncolq PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Where the elements can be found: ") - (radioButtons wheret - (" " " the elements of \zeta are in ZETA, returned by F01QCF/F01QFF" subsequent) - (" " " the elements of \zeta are in A" initial)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'f01qefSolve) - htShowPage() - -f01qefSolve htPage == - m := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) - objValUnwrap htpLabelSpadValue(htPage, 'm) - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - lda := m --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lda) --- objValUnwrap htpLabelSpadValue(htPage, 'lda) - ncolq := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ncolq) - objValUnwrap htpLabelSpadValue(htPage, 'ncolq) - elements := htpButtonValue(htPage,'wheret) - wheret := - elements = 'initial => '"i" - '"s" - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - ((m = '5 and n = '3) and ncolq = '5) => f01qefDefaultSolve(htPage,lda,wheret,ifail) - matList := - "append"/[fa(i,ncolq) for i in 1..lda] where fa(i,ncolq) == - labelList := - "append"/[ga(i,j) for j in 1..ncolq] where ga(i,j) == - anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) - [['bcStrings,[7, "0.0", anam, 'F]]] - prefix := ('"\newline ") - labelList := [['text,:prefix],:labelList] - zList := - "append"/[fz(i) for i in 1..n] where fz(i) == - znam := INTERN STRCONC ('"z",STRINGIMAGE i) - [['bcStrings,[7, "0.0", znam, 'F]]] - prefix := ("\blankline \menuitemstyle{}\tab{2} Enter values of \zeta ") - prefix := STRCONC(prefix,"(if required): \newline ") - zList := [['text,:prefix],:zList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :matList,:zList] - page := htInitPage('"F01QEF - Operations with orthogonal matrices, form columns of {\it Q} after factorization by F01QCF or F01QFF",nil) - htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it Q}: " - htSay '"\newline " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'f01qefGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) --- htpSetProperty(page,'lda,lda) - htpSetProperty(page,'ncolq,ncolq) - htpSetProperty(page,'wheret,wheret) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -f01qefDefaultSolve (htPage,lda,wheret,ifail) == - n := '3 - m := '5 - ncolq := '5 - page := htInitPage('"F01QEF - Operations with orthogonal matrices, form columns of {\it Q} after factorization by F01QCF or F01QFF",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter values of {\it Q}") - (text . "(in this case returned by the default entries of F01QCF) : ") - (text . "\newline ") - (bcStrings (7 "-4.0" a11 F)) - (bcStrings (7 "-2.0" a12 F)) - (bcStrings (7 "-3.0" a13 F)) - (bcStrings (7 "0.0" a14 F)) - (bcStrings (7 "0.0" a15 F)) - (text . "\newline ") - (bcStrings (7 "0.4085" a21 F)) - (bcStrings (7 "-3.0" a22 F)) - (bcStrings (7 "-2.0" a23 F)) - (bcStrings (7 "0.0" a24 F)) - (bcStrings (7 "0.0" a25 F)) - (text . "\newline ") - (bcStrings (7 "0.3266" a31 F)) - (bcStrings (7 "-0.4619" a32 F)) - (bcStrings (7 "-4.0" a33 F)) - (bcStrings (7 "0.0" a34 F)) - (bcStrings (7 "0.0" a35 F)) - (text . "\newline ") - (bcStrings (7 "0.4082" a41 F)) - (bcStrings (7 "-0.5774" a42 F)) - (bcStrings (7 "0.0" a43 F)) - (bcStrings (7 "0.0" a44 F)) - (bcStrings (7 "0.0" a45 F)) - (text . "\newline ") - (bcStrings (7 "0.2449" a51 F)) - (bcStrings (7 "-0.3464" a52 F)) - (bcStrings (7 "-0.6326" a53 F)) - (bcStrings (7 "0.0" a54 F)) - (bcStrings (7 "0.0" a55 F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter values of \zeta: ") - (text . "\newline ") - (bcStrings (10 "1.2247" z1 F)) - (bcStrings (10 "1.1547" z2 F)) - (bcStrings (10 "1.2649" z3 F)) - (text . "\blankline ")) - htMakeDoneButton('"Continue",'f01qefGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) --- htpSetProperty(page,'lda,lda) - htpSetProperty(page,'ncolq,ncolq) - htpSetProperty(page,'wheret,wheret) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f01qefGen htPage == - n := htpProperty(htPage,'n) - m := htpProperty(htPage,'m) --- lda := htpProperty(htPage,'lda) - lda := m - ncolq := htpProperty(htPage,'ncolq) - wheret := htpProperty(htPage,'wheret) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - for i in 1..n repeat - left := STRCONC((first y).1," ") - y := rest y - zetalist := [left,:zetalist] - zetastring := bcwords2liststring zetalist - y := REVERSE y - for i in 1..lda repeat - for j in 1..ncolq repeat - elm := STRCONC((first y).1," ") - rowList := [:rowList,elm] - y := rest y - matform := [:matform,rowList] - rowList := [] - matstring := bcwords2liststring [bcwords2liststring x for x in matform] - prefix := STRCONC('"f01qef(_"",wheret,"_",",STRINGIMAGE m,", ") - prefix := STRCONC(prefix,STRINGIMAGE n,", ",STRINGIMAGE lda,", ") - prefix := STRCONC(prefix,STRINGIMAGE ncolq,",[",zetastring,"],") - prefix := STRCONC(prefix,matstring,", ",STRINGIMAGE ifail,")") - linkGen prefix - -f01rcf() == - htInitPage('"F01RCF - {\it QR} factorization of complex {\it m} by {\it n} matrix (m \htbitmap{great=} n)",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXf01rcf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f01rcf| '|NagMatrixOperationsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "Finds the QR factorization of the complex m by n matrix {\it A},") - (text . " which is factorized as \htbitmap{f01qcf}, where m > n") - (text . " and A = QR when m = n , where Q is an m by m unitary matrix ") - (text . "and R is an n by n upper triangular matrix with real diagonal ") - (text . "elements. The {\it k}th transformation matrix,{\it Qk}, ") - (text . "which is used to introduce zeros into the {\it k}th column of ") - (text . "{\it A}, is given in the form ") - (text . "\htbitmap{f01qcf1}, ") - (text . "where \htbitmap{f01rdf2}, ") - (text . "\htbitmap{f01qcf3}, ") - (text . "\htbitmap{gammak} is a scalar for which Re ") - (text . "\htbitmap{gammak} = 1.0, \htbitmap{zetak} ") - (text . "is a real scalar and \htbitmap{zk} is an ") - (text . "(m-k) element vector. ") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline Rows of matrix A, {\it m}: ") - (text . "\tab{32} \menuitemstyle{} \tab{34} ") - (text . "Columns of matrix A, {\it n}: \newline \tab{2} ") - (bcStrings (6 5 m PI)) - (text . "\tab{34} ") - (bcStrings (6 3 n PI)) --- (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{} \tab{2} ") --- (text . "\newline First dimension of A, {\it lda} ") --- (text . "\htbitmap{great=} m: ") --- (text . "\newline \tab{2} ") --- (bcStrings (6 5 lda PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'f01rcfSolve) - htShowPage() - -f01rcfSolve htPage == - m := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) - objValUnwrap htpLabelSpadValue(htPage, 'm) - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - lda := m --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lda) --- objValUnwrap htpLabelSpadValue(htPage, 'lda) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - (m = '5 and n = '3) => f01rcfDefaultSolve(htPage,ifail) - matList := - "append"/[fa(i,n) for i in 1..lda] where fa(i,n) == - labelList := - "append"/[ga(i,j) for j in 1..n] where ga(i,j) == - anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) - [['bcStrings,[16, "0.0 + 0.0*%i", anam, 'F]]] - prefix := ('"\newline \tab{2} ") - labelList := [['text,:prefix],:labelList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :matList] - page := htInitPage('"F01RCF - {\it QR} factorization of complex {\it m} by {\it n} matrix (m \htbitmap{great=} n)",nil) - htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " - htSay '"\newline \tab{2} " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'f01rcfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) --- htpSetProperty(page,'lda,lda) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -f01rcfDefaultSolve (htPage,ifail) == - n := '3 - m := '5 - lda := '5 - page := htInitPage('"F01RCF - {\it QR} factorization of complex {\it m} by {\it n} matrix (m \htbitmap{great=} n)",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ") - (text . "\newline \tab{2} ") - (bcStrings (15 "0.5*%i" a11 F)) - (bcStrings (15 "-0.5 + 1.5*%i" a12 F)) - (bcStrings (15 "-1.0 + 1.0*%i" a13 F)) - (text . "\newline \tab{2} ") - (bcStrings (15 "0.4 + 0.3*%i" a21 F)) - (bcStrings (15 "0.9 + 1.3*%i" a22 F)) - (bcStrings (15 "0.2 + 1.4*%i" a23 F)) - (text . "\newline \tab{2} ") - (bcStrings (15 "0.4" a31 F)) - (bcStrings (15 "-0.4 + 0.4*%i" a32 F)) - (bcStrings (15 "1.8" a33 F)) - (text . "\newline \tab{2} ") - (bcStrings (15 "0.3 - 0.4*%i" a41 F)) - (bcStrings (15 "0.1 + 0.7*%i" a42 F)) - (bcStrings (15 "0.0" a43 F)) - (text . "\newline \tab{2} ") - (bcStrings (15 "-0.3*%i" a51 F)) - (bcStrings (15 "0.3 + 0.3*%i" a52 F)) - (bcStrings (15 "2.4*%i" a53 F)) - (text . "\blankline ")) - htMakeDoneButton('"Continue",'f01rcfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) --- htpSetProperty(page,'lda,lda) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f01rcfGen htPage == - n := htpProperty(htPage,'n) - m := htpProperty(htPage,'m) --- lda := htpProperty(htPage,'lda) - lda := m - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - y := REVERSE y - for i in 1..lda repeat - for j in 1..n repeat - elm := STRCONC((first y).1," ") - rowList := [:rowList,elm] - y := rest y - matform := [:matform,rowList] - rowList := [] - matstring := bcwords2liststring [bcwords2liststring x for x in matform] - prefix := STRCONC('"f01rcf(",STRINGIMAGE m,", ",STRINGIMAGE n,", ") - prefix := STRCONC(prefix,STRINGIMAGE lda,", ",matstring) - linkGen STRCONC(prefix,", ",STRINGIMAGE ifail,")") - -f01rdf() == - htInitPage('"F01RDF - Operations with unitary matrices, compute {\it QB} or \htbitmap{f01rdf} after factorization by F01QCF",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXf01rdf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f01rdf| '|NagMatrixOperationsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "Performs one of the transformations B = QB or B = ") - (text . "\htbitmap{f01rdf}, where B is an m ") - (text . "by ncolb matrix and Q is an m by m ") - (text . "unitary matrix assumed to be given by Q = ") - (text . "\htbitmap{f01rdf1}, \htbitmap{f01qdf2} ") - (text . "being given in the form \htbitmap{f01qcf1}, ") - (text . "where \htbitmap{f01rdf2}, \htbitmap{f01qcf3}") - (text . ", \htbitmap{gammak} is a scalar for which Re ") - (text . "\htbitmap{gammak} = 1.0, \htbitmap{zetak} ") - (text . "is a real scalar and \htbitmap{zk} is an ") - (text . "(m-k) element vector. ") - (text . "The routine is intended for use following F01QCF or F01QFF. ") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline Rows of matrix A, {\it m}: ") - (text . "\tab{32} \menuitemstyle{} \tab{34} ") - (text . "Columns of matrix A, {\it n}: \newline \tab{2} ") - (bcStrings (6 5 m PI)) - (text . "\tab{34} ") - (bcStrings (6 3 n PI)) --- (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{} \tab{2} ") --- (text . "\newline First dimension of A, {\it lda} ") --- (text . "\htbitmap{great=} m: ") --- (text . "\tab{32} \menuitemstyle{} \tab{34} ") --- (text . "First dimension of B, {\it ldb} ") --- (text . "\htbitmap{great=} m: ") --- (text . "\newline \tab{2} ") --- (bcStrings (6 5 lda PI)) --- (text . "\tab{34} ") --- (bcStrings (6 5 ldb PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Number of columns of matrix B {\it ncolb}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 2 ncolb PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Transformation to be performed: ") - (radioButtons trans - (" " " {\it B = QB}" no_trans) - (" " " {\it B =} \htbitmap{f01rdf} (Conjugate Transpose)" trans)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Where the elements can be found: ") - (radioButtons wheret - (" " " the elements of \theta are in A" in_a) - (" " " the elements of \theta are in THETA" seperate)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'f01rdfSolve) - htShowPage() - -f01rdfSolve htPage == - m := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) - objValUnwrap htpLabelSpadValue(htPage, 'm) - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - lda := m --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lda) --- objValUnwrap htpLabelSpadValue(htPage, 'lda) - ldb := m --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ldb) --- objValUnwrap htpLabelSpadValue(htPage, 'ldb) - ncolb := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ncolb) - objValUnwrap htpLabelSpadValue(htPage, 'ncolb) - operation := htpButtonValue(htPage,'trans) - trans := - operation = 'no_trans => '"n" - '"c" - elements := htpButtonValue(htPage,'wheret) - wheret := - elements = 'in_a => '"i" - '"c" - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - ((m = '5 and n = '3) and ncolb = '2) => f01rdfDefaultSolve(htPage,lda,ldb,trans,wheret,ifail) - matList := - "append"/[fa(i,n) for i in 1..lda] where fa(i,n) == - labelList := - "append"/[ga(i,j) for j in 1..n] where ga(i,j) == - anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) - [['bcStrings,[16, "0.0 + 0.0*%i", anam, 'F]]] - prefix := ('"\newline \tab{2} ") - labelList := [['text,:prefix],:labelList] - bList := - "append"/[fb(i,ncolb) for i in 1..ldb] where fb(i,ncolb) == - labelList := - "append"/[gb(i,j) for j in 1..ncolb] where gb(i,j) == - bnam := INTERN STRCONC ('"b",STRINGIMAGE i, STRINGIMAGE j) - [['bcStrings,[16, "0.0 + 0.0*%i", bnam, 'F]]] - prefix := ('"\newline \tab{2} ") - labelList := [['text,:prefix],:labelList] - prefix := ("\blankline \menuitemstyle{}\tab{2} Enter values of {\it B}: ") - bList := [['text,:prefix],:bList] - zList := - "append"/[fz(i) for i in 1..n] where fz(i) == - znam := INTERN STRCONC ('"z",STRINGIMAGE i) - [['bcStrings,[16, "0.0", znam, 'F]]] - prefix := ("\blankline \menuitemstyle{}\tab{2} Enter values of \theta ") - prefix := STRCONC(prefix,"(if required): \newline \tab{2}") - zList := [['text,:prefix],:zList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :matList,:bList,:zList] - page := htInitPage('"F01RDF - Operations with orthogonal matrices, compute {\it QB} or \htbitmap{f01rdf} after factorization by F01QCF or F01RDF",nil) - htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " - htSay '"\newline \tab{2} " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'f01rdfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) --- htpSetProperty(page,'lda,lda) --- htpSetProperty(page,'ldb,ldb) - htpSetProperty(page,'ncolb,ncolb) - htpSetProperty(page,'trans,trans) - htpSetProperty(page,'wheret,wheret) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -f01rdfDefaultSolve (htPage,lda,ldb,trans,wheret,ifail) == - n := '3 - m := '5 - ncolb := '2 - page := htInitPage('"F01RDF - Operations with orthogonal matrices, compute {\it QB} or \htbitmap{f01rdf} after factorization by F01QCF or F01RDF",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ") - (text . "\newline \tab{2} ") - (bcStrings (15 "0.5*%i" a11 F)) - (bcStrings (15 "-0.5 + 1.5*%i" a12 F)) - (bcStrings (15 "-1.0 + 1.0*%i" a13 F)) - (text . "\newline \tab{2} ") - (bcStrings (15 "0.4 + 0.3*%i" a21 F)) - (bcStrings (15 "0.9 + 1.3*%i" a22 F)) - (bcStrings (15 "0.2 + 1.4*%i" a23 F)) - (text . "\newline \tab{2} ") - (bcStrings (15 "0.4" a31 F)) - (bcStrings (15 "-0.4 + 0.4*%i" a32 F)) - (bcStrings (15 "1.8" a33 F)) - (text . "\newline \tab{2} ") - (bcStrings (15 "0.3 - 0.4*%i" a41 F)) - (bcStrings (15 "0.1 + 0.7*%i" a42 F)) - (bcStrings (15 "0.0" a43 F)) - (text . "\newline \tab{2} ") - (bcStrings (15 "-0.3*%i" a51 F)) - (bcStrings (15 "0.3 + 0.3*%i" a52 F)) - (bcStrings (15 "2.4" a53 F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} Enter values of {\it B}: ") - (text . "\newline \tab{2} ") - (bcStrings (15 "-0.55 + 1.05*%i" b11 F)) - (bcStrings (15 "0.45 + 1.05*%i" b12 F)) - (text . "\newline \tab{2} ") - (bcStrings (15 "0.49 + 0.93*%i" b21 F)) - (bcStrings (15 "1.09 + 0.13*%i" b22 F)) - (text . "\newline \tab{2} ") - (bcStrings (15 "0.56 - 0.16*%i" b31 F)) - (bcStrings (15 "0.64 + 0.16*%i" b32 F)) - (text . "\newline \tab{2} ") - (bcStrings (15 "0.39 + 0.23*%i" b41 F)) - (bcStrings (15 "-0.39 - 0.23*%i" b42 F)) - (text . "\newline \tab{2} ") - (bcStrings (15 "1.13 + 0.83*%i" b51 F)) - (bcStrings (15 "-1.13 + 0.77*%i" b52 F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter values of \theta (if required): ") - (text . "\newline \tab{2} ") - (bcStrings (15 "0.0" z1 F)) - (bcStrings (15 "0.0" z2 F)) - (bcStrings (15 "0.0" z3 F)) - (text . "\blankline ")) - htMakeDoneButton('"Continue",'f01rdfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) --- htpSetProperty(page,'lda,lda) --- htpSetProperty(page,'ldb,ldb) - htpSetProperty(page,'ncolb,ncolb) - htpSetProperty(page,'trans,trans) - htpSetProperty(page,'wheret,wheret) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f01rdfGen htPage == - n := htpProperty(htPage,'n) - m := htpProperty(htPage,'m) --- lda := htpProperty(htPage,'lda) --- ldb := htpProperty(htPage,'ldb) - lda := m - ldb := m - ncolb := htpProperty(htPage,'ncolb) - trans := htpProperty(htPage,'trans) - wheret := htpProperty(htPage,'wheret) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - for i in 1..n repeat - left := STRCONC((first y).1," ") - y := rest y - zetalist := [left,:zetalist] - zetastring := bcwords2liststring zetalist - y := REVERSE y - for i in 1..lda repeat - for j in 1..n repeat - elm := STRCONC((first y).1," ") - rowList := [:rowList,elm] - y := rest y - matform := [:matform,rowList] - rowList := [] - matstring := bcwords2liststring [bcwords2liststring x for x in matform] - for i in 1..ldb repeat - for j in 1..ncolb repeat - elm := STRCONC((first y).1," ") - rowList := [:rowList,elm] - y := rest y - bform := [:bform,rowList] - rowList := [] - bstring := bcwords2liststring [bcwords2liststring x for x in bform] - prefix := STRCONC('"f01rdf(_"",trans,"_",_"",wheret,"_",",STRINGIMAGE m,", ") - prefix := STRCONC(prefix,STRINGIMAGE n,", ",matstring,", ",STRINGIMAGE lda) - prefix := STRCONC(prefix,",[",zetastring,"],",STRINGIMAGE ncolb,", ") - prefix := STRCONC(prefix,STRINGIMAGE ldb,", ",bstring,", ",STRINGIMAGE ifail,")") - linkGen prefix - - -f01ref() == - htInitPage('"F01REF - Operations with unitary matrices, form columns of {\it Q} after factorization by F01RCF",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXf01ref} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f01ref| '|NagMatrixOperationsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "Returns the first {\it ncolq} columns of the real {\it m} by ") - (text . "{\it m} unitary matrix {\it Q}, where {\it Q} is assumed ") - (text . "to be given by {\it Q = }\htbitmap{f01rdf1}, ") - (text . "\htbitmap{f01qdf2} being given in the form ") - (text . "\htbitmap{f01qcf1}, ") - (text . "where \htbitmap{f01rdf2}, ") - (text . "\htbitmap{f01qcf3}, ") - (text . "\htbitmap{gammak} is a scalar for which Re ") - (text . "\htbitmap{gammak} = 1.0, \htbitmap{zetak} ") - (text . "is a real scalar and \htbitmap{zk} is an ") - (text . "(m-k) element vector. ") - (text . "The routine is intended for use following F01RCF or F01RFF. ") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline Rows of matrix A, {\it m}: ") - (text . "\tab{32} \menuitemstyle{} \tab{34} ") - (text . "Columns of matrix A, {\it n}: \newline \tab{2} ") - (bcStrings (6 5 m PI)) - (text . "\tab{34} ") - (bcStrings (6 3 n PI)) --- (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{} \tab{2} ") --- (text . "\newline First dimension of A, {\it lda} ") --- (text . "\htbitmap{great=} m: ") --- (text . "\newline \tab{2} ") --- (bcStrings (6 5 lda PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Required number of columns of matrix Q {\it ncolq}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 2 ncolq PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Where the elements can be found: ") - (radioButtons wheret - (" " " the elements of \theta are in THETA" seperate) - (" " " the elements of \theta are in A" in_a)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'f01refSolve) - htShowPage() - -f01refSolve htPage == - m := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) - objValUnwrap htpLabelSpadValue(htPage, 'm) - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - lda := m --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lda) --- objValUnwrap htpLabelSpadValue(htPage, 'lda) - ncolq := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ncolq) - objValUnwrap htpLabelSpadValue(htPage, 'ncolq) - elements := htpButtonValue(htPage,'wheret) - wheret := - elements = 'in_a => '"i" - '"s" - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - ((m = '5 and n = '3) and ncolq = '2) => f01refDefaultSolve(htPage,lda,wheret,ifail) - matList := - "append"/[fa(i,n) for i in 1..lda] where fa(i,n) == - labelList := - "append"/[ga(i,j) for j in 1..n] where ga(i,j) == - anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) - [['bcStrings,[20, "0.0 + 0.0*%i", anam, 'F]]] - prefix := ('"\newline \tab{2} ") - labelList := [['text,:prefix],:labelList] - zList := - "append"/[fz(i) for i in 1..n] where fz(i) == - znam := INTERN STRCONC ('"z",STRINGIMAGE i) - [['bcStrings,[20, "0.0", znam, 'F]]] - prefix := ("\blankline \menuitemstyle{}\tab{2} Enter values of \theta ") - prefix := STRCONC(prefix,"(if required): \newline \tab{2}") - zList := [['text,:prefix],:zList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :matList,:zList] - page := htInitPage('"F01REF - Operations with unitary matrices, form columns of {\it Q} after factorization by F01RCF",nil) - htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " - htSay '"\newline \tab{2} " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'f01refGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) --- htpSetProperty(page,'lda,lda) - htpSetProperty(page,'ncolq,ncolq) - htpSetProperty(page,'wheret,wheret) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -f01refDefaultSolve (htPage,lda,wheret,ifail) == - n := '3 - m := '5 - ncolq := '2 - page := htInitPage('"F01REF - Operations with unitary matrices, form columns of {\it Q} after factorization by F01RCF",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ") - (text . "\newline \tab{2} ") - (bcStrings (16 "1" a11 F)) - (bcStrings (16 "1 + %i" a12 F)) - (bcStrings (16 "1 + %i" a13 F)) - (text . "\newline \tab{2} ") - (bcStrings (16 "-0.2-0.4*%i" a21 F)) - (bcStrings (16 "-2" a22 F)) - (bcStrings (16 "-1 - %i" a23 F)) - (text . "\newline \tab{2} ") - (bcStrings (16 "-0.32 - 0.16*%i" a31 F)) - (bcStrings (16 "-0.3505+0.263*%i" a32 F)) - (bcStrings (16 "-3" a33 F)) - (text . "\newline \tab{2} ") - (bcStrings (16 "-0.4 + 0.2*%i" a41 F)) - (bcStrings (16 "0.5477*%i" a42 F)) - (bcStrings (16 "0.0" a43 F)) - (text . "\newline \tab{2} ") - (bcStrings (16 "-0.12 + 0.24*%i" a51 F)) - (bcStrings (16 "0.1972+0.2629*%i" a52 F)) - (bcStrings (16 "0.6325" a53 F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter values of \theta: ") - (text . "\newline \tab{2} ") - (bcStrings (16 "1 + 0.5*%i" z1 F)) - (bcStrings (16 "1.0954-0.3333*%i" z2 F)) - (bcStrings (16 "1.2649-1.1565*%i" z3 F)) - (text . "\blankline ")) - htMakeDoneButton('"Continue",'f01refGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) --- htpSetProperty(page,'lda,lda) - htpSetProperty(page,'ncolq,ncolq) - htpSetProperty(page,'wheret,wheret) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f01refGen htPage == - n := htpProperty(htPage,'n) - m := htpProperty(htPage,'m) --- lda := htpProperty(htPage,'lda) - lda := m - ncolq := htpProperty(htPage,'ncolq) - wheret := htpProperty(htPage,'wheret) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - for i in 1..n repeat - left := STRCONC((first y).1," ") - y := rest y - thetalist := [left,:thetalist] - thetastring := bcwords2liststring thetalist - y := REVERSE y - for i in 1..lda repeat - for j in 1..n repeat - elm := STRCONC((first y).1," ") - rowList := [:rowList,elm] - y := rest y - matform := [:matform,rowList] - rowList := [] - matstring := bcwords2liststring [bcwords2liststring x for x in matform] - prefix := STRCONC('"f01ref(_"",wheret,"_",",STRINGIMAGE m,", ") - prefix := STRCONC(prefix,STRINGIMAGE n,", ",STRINGIMAGE ncolq,", ") - prefix := STRCONC(prefix,STRINGIMAGE lda,",[",thetastring,"],") - prefix := STRCONC(prefix,matstring,", ",STRINGIMAGE ifail,")") - linkGen prefix - -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/nag-f01.lisp.pamphlet b/src/interp/nag-f01.lisp.pamphlet new file mode 100644 index 0000000..e982352 --- /dev/null +++ b/src/interp/nag-f01.lisp.pamphlet @@ -0,0 +1,5481 @@ +\documentclass{article} +\usepackage{axiom} +\begin{document} +\title{\$SPAD/src/interp nag-f01.lisp} +\author{The Axiom Team} +\maketitle +\begin{abstract} +\end{abstract} +\eject +\tableofcontents +\eject +<<*>>= + +(IN-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() + +(DEFUN |f01brf| () + (PROGN + (|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" |grtrue|) + ("" " False" |grfalse|)) + (|text| . "\\blankline") + (|text| . "\\menuitemstyle{}\\tab{2} Lblock value:") + (|radioButtons| |lblock| ("" " True" |lbtrue|) + ("" " False" |lbfalse|)) + (|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| (MAKESTRING "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() + +(DEFUN |f01brfSolve,f| (|i|) + (PROG (|prefix| |anam| |mid| |rnam| |end| |cnam|) + (RETURN + (SEQ (SPADLET |prefix| (MAKESTRING "\\newline \\tab{2} ")) + (SPADLET |anam| + (INTERN (STRCONC (MAKESTRING "a") + (STRINGIMAGE |i|)))) + (SPADLET |mid| (MAKESTRING "\\tab{32} ")) + (SPADLET |rnam| + (INTERN (STRCONC (MAKESTRING "irn") + (STRINGIMAGE |i|)))) + (SPADLET |end| (MAKESTRING "\\tab{42} ")) + (SPADLET |cnam| + (INTERN (STRCONC (MAKESTRING "icn") + (STRINGIMAGE |i|)))) + (EXIT (CONS (CONS '|text| |prefix|) + (CONS (CONS '|bcStrings| + (CONS + (CONS 8 + (CONS 0.0 + (CONS |anam| (CONS 'F NIL)))) + NIL)) + (CONS (CONS '|text| |mid|) + (CONS + (CONS '|bcStrings| + (CONS + (CONS 4 + (CONS 0 + (CONS |rnam| (CONS 'PI NIL)))) + NIL)) + (CONS (CONS '|text| |end|) + (CONS + (CONS '|bcStrings| + (CONS + (CONS 4 + (CONS 0 + (CONS |cnam| (CONS 'PI NIL)))) + NIL)) + NIL))))))))))) + +(DEFUN |f01brfSolve| (|htPage|) + (PROG (|n| |nz| |licn| |lirn| |pivot| |gr| |grow| |lb| |lblock| + |aerror| |afail| |berror| |bfail| |cerror| |cfail| |ifail| + |labelList| |prefix| |abortList| |equationPart| |page|) + (declare (special |$EmptyMode| |$bcParseOnly|)) + (RETURN + (SEQ (PROGN + (SPADLET |n| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|n|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|n|))))) + (SPADLET |nz| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|nz|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|nz|))))) + (SPADLET |licn| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| + '|licn|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|licn|))))) + (SPADLET |lirn| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| + '|lirn|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|lirn|))))) + (SPADLET |pivot| + (|htpLabelInputString| |htPage| '|pivot|)) + (SPADLET |gr| (|htpButtonValue| |htPage| '|grow|)) + (SPADLET |grow| + (COND + ((BOOT-EQUAL |gr| '|grtrue|) + (MAKESTRING "true")) + ('T (MAKESTRING "false")))) + (SPADLET |lb| (|htpButtonValue| |htPage| '|lblock|)) + (SPADLET |lblock| + (COND + ((BOOT-EQUAL |lb| '|lbtrue|) + (MAKESTRING "true")) + ('T (MAKESTRING "false")))) + (SPADLET |aerror| (|htpButtonValue| |htPage| '|afail|)) + (SPADLET |afail| + (COND + ((BOOT-EQUAL |aerror| '|azero|) '0) + ('T '1))) + (SPADLET |berror| (|htpButtonValue| |htPage| '|bfail|)) + (SPADLET |bfail| + (COND + ((BOOT-EQUAL |berror| '|bone|) '1) + ('T '0))) + (SPADLET |cerror| (|htpButtonValue| |htPage| '|cfail|)) + (SPADLET |cfail| + (COND + ((BOOT-EQUAL |cerror| '|cone|) '1) + ('T '0))) + (SPADLET |ifail| + (PLUS (PLUS (TIMES 100 |cfail|) + (TIMES 10 |bfail|)) + |afail|)) + (COND + ((AND (BOOT-EQUAL |n| '6) (BOOT-EQUAL |nz| '15) + (BOOT-EQUAL |licn| '150) (BOOT-EQUAL |lirn| '75)) + (|f01brfDefaultSolve| |htPage| |pivot| |grow| |lblock| + |ifail|)) + ('T + (SPADLET |labelList| + (PROG (G166082) + (SPADLET G166082 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |nz|) G166082) + (SEQ (EXIT + (SETQ G166082 + (APPEND G166082 + (|f01brfSolve,f| |i|))))))))) + (SPADLET |abortList| + (CONS (CONS '|bcStrings| + (CONS + (CONS 6 + (CONS (MAKESTRING "true") + (CONS '|abortone| + (CONS 'EM NIL)))) + NIL)) + (CONS (CONS '|bcStrings| + (CONS + (CONS 6 + (CONS (MAKESTRING "true") + (CONS '|aborttwo| + (CONS 'EM NIL)))) + NIL)) + (CONS + (CONS '|bcStrings| + (CONS + (CONS 6 + (CONS (MAKESTRING "false") + (CONS '|abortthree| + (CONS 'EM NIL)))) + NIL)) + (CONS + (CONS '|bcStrings| + (CONS + (CONS 6 + (CONS (MAKESTRING "true") + (CONS '|abortfour| + (CONS 'EM NIL)))) + NIL)) + NIL))))) + (SPADLET |prefix| + (MAKESTRING + "\\blankline \\menuitemstyle{}\\tab{2} Abort: ")) + (SPADLET |abortList| + (CONS (CONS '|text| |prefix|) |abortList|)) + (SPADLET |equationPart| + (CONS '(|domainConditions| + (|isDomain| P + (|Polynomial| |$EmptyMode|)) + (|isDomain| S (|String|)) + (|isDomain| EM (|EmptyMode|)) + (|isDomain| F (|Float|)) + (|isDomain| PI (|PositiveInteger|))) + (APPEND |labelList| |abortList|))) + (SPADLET |page| + (|htInitPage| + '|F01BRF - LU factorization of real sparse matrix| + NIL)) + (|htSay| (MAKESTRING + "\\menuitemstyle{}\\tab{2} Non-zero elements of A: ")) + (|htSay| (MAKESTRING + "\\tab{30} \\menuitemstyle{}\\tab{32} Row: ")) + (|htSay| (MAKESTRING + "\\tab{40} \\menuitemstyle{}\\tab{42} Column: ")) + (|htMakePage| |equationPart|) + (|htSay| (MAKESTRING "\\blankline ")) + (|htMakeDoneButton| (MAKESTRING "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() + +(DEFUN |f01brfDefaultSolve| (|htPage| |pivot| |grow| |lblock| |ifail|) + (PROG (|n| |nz| |licn| |lirn| |page|) + (declare (special |$EmptyMode|)) + (RETURN + (PROGN + (SPADLET |n| '6) + (SPADLET |nz| '15) + (SPADLET |licn| '150) + (SPADLET |lirn| '75) + (SPADLET |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" |abortone| EM)) + (|bcStrings| (8 "true" |aborttwo| EM)) + (|bcStrings| (8 "false" |abortthree| EM)) + (|bcStrings| (8 "true" |abortfour| EM)))) + (|htMakeDoneButton| (MAKESTRING "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,")") + +(DEFUN |f01brfGen| (|htPage|) + (PROG (|n| |nz| |licn| |lirn| |pivot| |grow| |lblock| |ifail| |alist| + |abort| |abortList| |astring| |end| |mid| |top| |y| + |cList| |matList| |rList| |cstring| |rstring| |matstring| + |prefix|) + (RETURN + (SEQ (PROGN + (SPADLET |n| (|htpProperty| |htPage| '|n|)) + (SPADLET |nz| (|htpProperty| |htPage| '|nz|)) + (SPADLET |licn| (|htpProperty| |htPage| '|licn|)) + (SPADLET |lirn| (|htpProperty| |htPage| '|lirn|)) + (SPADLET |pivot| (|htpProperty| |htPage| '|pivot|)) + (SPADLET |grow| (|htpProperty| |htPage| '|grow|)) + (SPADLET |lblock| (|htpProperty| |htPage| '|lblock|)) + (SPADLET |ifail| (|htpProperty| |htPage| '|ifail|)) + (SPADLET |alist| (|htpInputAreaAlist| |htPage|)) + (SPADLET |y| |alist|) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| 4) NIL) + (SEQ (EXIT (PROGN + (SPADLET |abort| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |y| (CDR |y|)) + (SPADLET |abortList| + (CONS |abort| |abortList|)))))) + (SPADLET |astring| (|bcwords2liststring| |abortList|)) + (DO () ((NULL |y|) NIL) + (SEQ (EXIT (PROGN + (SPADLET |end| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |y| (CDR |y|)) + (SPADLET |mid| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |y| (CDR |y|)) + (SPADLET |top| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |y| (CDR |y|)) + (SPADLET |cList| (CONS |end| |cList|)) + (SPADLET |rList| (CONS |mid| |rList|)) + (SPADLET |matList| (CONS |top| |matList|)))))) + (DO ((G166158 (SPADDIFFERENCE |licn| |nz|)) + (|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| G166158) NIL) + (SEQ (EXIT (PROGN + (SPADLET |cList| + (APPEND |cList| + (CONS (MAKESTRING "0 ") NIL))) + (SPADLET |matList| + (APPEND |matList| + (CONS (MAKESTRING "0 ") NIL))))))) + (DO ((G166165 (SPADDIFFERENCE |lirn| |nz|)) + (|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| G166165) NIL) + (SEQ (EXIT (SPADLET |rList| + (APPEND |rList| + (CONS (MAKESTRING "0 ") NIL)))))) + (SPADLET |cstring| (|bcwords2liststring| |cList|)) + (SPADLET |rstring| (|bcwords2liststring| |rList|)) + (SPADLET |matstring| (|bcwords2liststring| |matList|)) + (SPADLET |prefix| + (STRCONC (MAKESTRING "f01brf(") (STRINGIMAGE |n|) + '|, | (STRINGIMAGE |nz|) '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |licn|) '|, | + (STRINGIMAGE |lirn|) '|, | |pivot|)) + (SPADLET |prefix| + (STRCONC |prefix| '|, | |lblock| '|, | |grow| + '|, | |astring| '|,[| |matstring|)) + (SPADLET |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() + +(DEFUN |f01bsf| () + (PROGN + (|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() + +(DEFUN |f01maf| () + (PROGN + (|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| (MAKESTRING "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() + +(DEFUN |f01mafSolve,f| (|i|) + (PROG (|prefix| |anam| |mid| |rnam| |end| |cnam|) + (RETURN + (SEQ (SPADLET |prefix| (MAKESTRING "\\newline \\tab{2} ")) + (SPADLET |anam| + (INTERN (STRCONC (MAKESTRING "a") + (STRINGIMAGE |i|)))) + (SPADLET |mid| (MAKESTRING "\\tab{32} ")) + (SPADLET |rnam| + (INTERN (STRCONC (MAKESTRING "irn") + (STRINGIMAGE |i|)))) + (SPADLET |end| (MAKESTRING "\\tab{42} ")) + (SPADLET |cnam| + (INTERN (STRCONC (MAKESTRING "icn") + (STRINGIMAGE |i|)))) + (EXIT (CONS (CONS '|text| |prefix|) + (CONS (CONS '|bcStrings| + (CONS + (CONS 8 + (CONS 0.0 + (CONS |anam| (CONS 'F NIL)))) + NIL)) + (CONS (CONS '|text| |mid|) + (CONS + (CONS '|bcStrings| + (CONS + (CONS 4 + (CONS 0 + (CONS |rnam| (CONS 'PI NIL)))) + NIL)) + (CONS (CONS '|text| |end|) + (CONS + (CONS '|bcStrings| + (CONS + (CONS 4 + (CONS 0 + (CONS |cnam| (CONS 'PI NIL)))) + NIL)) + NIL))))))))))) + +(DEFUN |f01mafSolve| (|htPage|) + (PROG (|n| |nz| |licn| |lirn| |aerror| |afail| |berror| |bfail| + |cerror| |cfail| |ifail| |droptl| |densw| |labelList| + |prefix| |abortList| |equationPart| |page|) + (declare (special |$EmptyMode| |$bcParseOnly|)) + (RETURN + (SEQ (PROGN + (SPADLET |n| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|n|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|n|))))) + (SPADLET |nz| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|nz|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|nz|))))) + (SPADLET |licn| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| + '|licn|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|licn|))))) + (SPADLET |lirn| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| + '|lirn|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|lirn|))))) + (SPADLET |aerror| (|htpButtonValue| |htPage| '|afail|)) + (SPADLET |afail| + (COND + ((BOOT-EQUAL |aerror| '|azero|) '0) + ('T '1))) + (SPADLET |berror| (|htpButtonValue| |htPage| '|bfail|)) + (SPADLET |bfail| + (COND + ((BOOT-EQUAL |berror| '|bone|) '1) + ('T '0))) + (SPADLET |cerror| (|htpButtonValue| |htPage| '|cfail|)) + (SPADLET |cfail| + (COND + ((BOOT-EQUAL |cerror| '|cone|) '1) + ('T '0))) + (SPADLET |ifail| + (PLUS (PLUS (TIMES 100 |cfail|) + (TIMES 10 |bfail|)) + |afail|)) + (SPADLET |droptl| + (|htpLabelInputString| |htPage| '|droptl|)) + (SPADLET |densw| + (|htpLabelInputString| |htPage| '|densw|)) + (COND + ((AND (BOOT-EQUAL |n| '16) (BOOT-EQUAL |nz| '40) + (BOOT-EQUAL |licn| '90) (BOOT-EQUAL |lirn| '50)) + (|f01mafDefaultSolve| |htPage| |droptl| |densw| + |ifail|)) + ('T + (SPADLET |labelList| + (PROG (G166232) + (SPADLET G166232 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |nz|) G166232) + (SEQ (EXIT + (SETQ G166232 + (APPEND G166232 + (|f01mafSolve,f| |i|))))))))) + (SPADLET |abortList| + (CONS (CONS '|bcStrings| + (CONS + (CONS 6 + (CONS (MAKESTRING "true") + (CONS '|abortone| + (CONS 'EM NIL)))) + NIL)) + (CONS (CONS '|bcStrings| + (CONS + (CONS 6 + (CONS (MAKESTRING "true") + (CONS '|aborttwo| + (CONS 'EM NIL)))) + NIL)) + (CONS + (CONS '|bcStrings| + (CONS + (CONS 6 + (CONS (MAKESTRING "true") + (CONS '|abortthree| + (CONS 'EM NIL)))) + NIL)) + NIL)))) + (SPADLET |prefix| + (MAKESTRING + "\\blankline \\menuitemstyle{}\\tab{2} Abort: ")) + (SPADLET |abortList| + (CONS (CONS '|text| |prefix|) |abortList|)) + (SPADLET |equationPart| + (CONS '(|domainConditions| + (|isDomain| P + (|Polynomial| |$EmptyMode|)) + (|isDomain| S (|String|)) + (|isDomain| EM (|EmptyMode|)) + (|isDomain| F (|Float|)) + (|isDomain| PI (|PositiveInteger|))) + (APPEND |labelList| |abortList|))) + (SPADLET |page| + (|htInitPage| + '|F01MAF - \\htbitmap{llt} factorization of real sparse symmetric positive-definite matrix| + NIL)) + (|htSay| (MAKESTRING + "\\menuitemstyle{}\\tab{2} Non-zero elements of A: ")) + (|htSay| (MAKESTRING + "\\tab{30} \\menuitemstyle{}\\tab{32} Row: ")) + (|htSay| (MAKESTRING + "\\tab{40} \\menuitemstyle{}\\tab{42} Column: ")) + (|htMakePage| |equationPart|) + (|htSay| (MAKESTRING "\\blankline ")) + (|htMakeDoneButton| (MAKESTRING "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() + +(DEFUN |f01mafDefaultSolve| (|htPage| |droptl| |densw| |ifail|) + (PROG (|n| |nz| |licn| |lirn| |page|) + (declare (special |$EmptyMode|)) + (RETURN + (PROGN + (SPADLET |n| '16) + (SPADLET |nz| '40) + (SPADLET |licn| '90) + (SPADLET |lirn| '50) + (SPADLET |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" |abortone| EM)) + (|bcStrings| (8 "true" |aborttwo| EM)) + (|bcStrings| (8 "true" |abortthree| EM)))) + (|htMakeDoneButton| (MAKESTRING "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,")") + +(DEFUN |f01mafGen| (|htPage|) + (PROG (|n| |nz| |licn| |lirn| |droptl| |densw| |ifail| |alist| + |abort| |abortList| |astring| |end| |mid| |top| |y| + |cList| |matList| |rList| |cstring| |rstring| |matstring| + |prefix|) + (RETURN + (SEQ (PROGN + (SPADLET |n| (|htpProperty| |htPage| '|n|)) + (SPADLET |nz| (|htpProperty| |htPage| '|nz|)) + (SPADLET |licn| (|htpProperty| |htPage| '|licn|)) + (SPADLET |lirn| (|htpProperty| |htPage| '|lirn|)) + (SPADLET |droptl| (|htpProperty| |htPage| '|droptl|)) + (SPADLET |densw| (|htpProperty| |htPage| '|densw|)) + (SPADLET |ifail| (|htpProperty| |htPage| '|ifail|)) + (SPADLET |alist| (|htpInputAreaAlist| |htPage|)) + (SPADLET |y| |alist|) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| 3) NIL) + (SEQ (EXIT (PROGN + (SPADLET |abort| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |y| (CDR |y|)) + (SPADLET |abortList| + (CONS |abort| |abortList|)))))) + (SPADLET |astring| (|bcwords2liststring| |abortList|)) + (DO () ((NULL |y|) NIL) + (SEQ (EXIT (PROGN + (SPADLET |end| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |y| (CDR |y|)) + (SPADLET |mid| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |y| (CDR |y|)) + (SPADLET |top| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |y| (CDR |y|)) + (SPADLET |cList| (CONS |end| |cList|)) + (SPADLET |rList| (CONS |mid| |rList|)) + (SPADLET |matList| (CONS |top| |matList|)))))) + (DO ((G166305 (SPADDIFFERENCE |licn| |nz|)) + (|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| G166305) NIL) + (SEQ (EXIT (PROGN + (SPADLET |cList| + (APPEND |cList| + (CONS (MAKESTRING "0 ") NIL))) + (SPADLET |matList| + (APPEND |matList| + (CONS (MAKESTRING "0 ") NIL))))))) + (DO ((G166312 (SPADDIFFERENCE |lirn| |nz|)) + (|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| G166312) NIL) + (SEQ (EXIT (SPADLET |rList| + (APPEND |rList| + (CONS (MAKESTRING "0 ") NIL)))))) + (SPADLET |cstring| (|bcwords2liststring| |cList|)) + (SPADLET |rstring| (|bcwords2liststring| |rList|)) + (SPADLET |matstring| (|bcwords2liststring| |matList|)) + (SPADLET |prefix| + (STRCONC (MAKESTRING "f01maf(") (STRINGIMAGE |n|) + '|, | (STRINGIMAGE |nz|) '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |licn|) '|, | + (STRINGIMAGE |lirn|) '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| |astring| '|,[| |matstring|)) + (SPADLET |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() + +(DEFUN |f01mcf| () + (PROGN + (|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| (MAKESTRING "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() + +(DEFUN |f01mcfSolve,f| (|i|) + (PROG (|xnam|) + (RETURN + (SEQ (SPADLET |xnam| + (INTERN (STRCONC (MAKESTRING "x") + (STRINGIMAGE |i|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 6 + (CONS 0.0 + (CONS |xnam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |f01mcfSolve,g| (|j|) + (PROG (|nam|) + (RETURN + (SEQ (SPADLET |nam| + (INTERN (STRCONC (MAKESTRING "n") + (STRINGIMAGE |j|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 6 + (CONS 0 + (CONS |nam| (CONS 'PI NIL)))) + NIL)) + NIL)))))) + +(DEFUN |f01mcfSolve| (|htPage|) + (PROG (|n| |lal| |error| |ifail| |labelList| |prefix| |nrowList| + |equationPart| |page|) + (declare (special |$EmptyMode| |$bcParseOnly|)) + (RETURN + (SEQ (PROGN + (SPADLET |n| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|n|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|n|))))) + (SPADLET |lal| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|lal|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|lal|))))) + (SPADLET |error| (|htpButtonValue| |htPage| '|ifail|)) + (SPADLET |ifail| + (COND ((BOOT-EQUAL |error| '|one|) '1) ('T '-1))) + (COND + ((AND (BOOT-EQUAL |n| '6) (BOOT-EQUAL |lal| '14)) + (|f01mcfDefaultSolve| |htPage| |ifail|)) + ('T + (SPADLET |labelList| + (PROG (G166371) + (SPADLET G166371 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |lal|) G166371) + (SEQ (EXIT + (SETQ G166371 + (APPEND G166371 + (|f01mcfSolve,f| |i|))))))))) + (SPADLET |nrowList| + (PROG (G166379) + (SPADLET G166379 NIL) + (RETURN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |n|) G166379) + (SEQ (EXIT + (SETQ G166379 + (APPEND G166379 + (|f01mcfSolve,g| |j|))))))))) + (SPADLET |prefix| + (MAKESTRING + "\\blankline \\menuitemstyle{}\\tab{2} {\\it NROW(n)} the width ")) + (SPADLET |prefix| + (STRCONC |prefix| + '|of the ith row of A: \\newline \\tab{2} |)) + (SPADLET |nrowList| + (CONS (CONS '|text| |prefix|) |nrowList|)) + (SPADLET |equationPart| + (CONS '(|domainConditions| + (|isDomain| P + (|Polynomial| |$EmptyMode|)) + (|isDomain| S (|String|)) + (|isDomain| F (|Float|)) + (|isDomain| PI (|PositiveInteger|))) + (APPEND |labelList| |nrowList|))) + (SPADLET |page| + (|htInitPage| + '|F01MCF - \\htbitmap{ldlt} factorization of real symmetric positive-definite variable-bandwidth matrix| + NIL)) + (|htSay| (MAKESTRING + "\\menuitemstyle{}\\tab{2} Elements of matrix {\\it A} in row by row ")) + (|htSay| (MAKESTRING "order: \\newline \\tab{2} ")) + (|htMakePage| |equationPart|) + (|htSay| (MAKESTRING "\\blankline ")) + (|htMakeDoneButton| (MAKESTRING "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() + +(DEFUN |f01mcfDefaultSolve| (|htPage| |ifail|) + (PROG (|n| |lal| |page|) + (RETURN + (PROGN + (SPADLET |n| '6) + (SPADLET |lal| '14) + (SPADLET |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| (MAKESTRING "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,")") + +(DEFUN |f01mcfGen| (|htPage|) + (PROG (|n| |lal| |ifail| |alist| |nrowList| |nrowstring| |right| |y| + |matList| |matstring| |prefix|) + (RETURN + (SEQ (PROGN + (SPADLET |n| (|htpProperty| |htPage| '|n|)) + (SPADLET |lal| (|htpProperty| |htPage| '|lal|)) + (SPADLET |ifail| (|htpProperty| |htPage| '|ifail|)) + (SPADLET |alist| (|htpInputAreaAlist| |htPage|)) + (SPADLET |y| |alist|) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |n|) NIL) + (SEQ (EXIT (PROGN + (SPADLET |right| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |y| (CDR |y|)) + (SPADLET |nrowList| + (CONS |right| |nrowList|)))))) + (SPADLET |nrowstring| (|bcwords2liststring| |nrowList|)) + (DO () ((NULL |y|) NIL) + (SEQ (EXIT (PROGN + (SPADLET |right| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |y| (CDR |y|)) + (SPADLET |matList| + (CONS |right| |matList|)))))) + (SPADLET |matstring| (|bcwords2liststring| |matList|)) + (SPADLET |prefix| + (STRCONC (MAKESTRING "f01mcf(") (STRINGIMAGE |n|) + '|, [| |matstring| '|], |)) + (SPADLET |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() + +(DEFUN |f01qcf| () + (PROGN + (|htInitPage| + (MAKESTRING + "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 \\tab{2} ") (|text| . "Ifail value: ") + (|radioButtons| |ifail| + ("" " -1, Print error messages" |minusOne|) + ("" " 1, Suppress error messages" |one|)))) + (|htMakeDoneButton| (MAKESTRING "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() + +(DEFUN |f01qcfSolve,g| (|i| |j|) + (PROG (|anam|) + (RETURN + (SEQ (SPADLET |anam| + (INTERN (STRCONC (MAKESTRING "a") (STRINGIMAGE |i|) + (STRINGIMAGE |j|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 6 + (CONS '|0.0| + (CONS |anam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |f01qcfSolve,f| (|i| |n|) + (PROG (|prefix| |labelList|) + (RETURN + (SEQ (SPADLET |labelList| + (PROG (G166463) + (SPADLET G166463 NIL) + (RETURN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |n|) G166463) + (SEQ (EXIT (SETQ G166463 + (APPEND G166463 + (|f01qcfSolve,g| |i| |j|))))))))) + (SPADLET |prefix| (MAKESTRING "\\newline \\tab{2} ")) + (EXIT (SPADLET |labelList| + (CONS (CONS '|text| |prefix|) |labelList|))))))) + +(DEFUN |f01qcfSolve| (|htPage|) + (PROG (|m| |n| |lda| |error| |ifail| |matList| |equationPart| |page|) + (declare (special |$EmptyMode| |$bcParseOnly|)) + (RETURN + (SEQ (PROGN + (SPADLET |m| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|m|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|m|))))) + (SPADLET |n| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|n|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|n|))))) + (SPADLET |lda| |m|) + (SPADLET |error| (|htpButtonValue| |htPage| '|ifail|)) + (SPADLET |ifail| + (COND ((BOOT-EQUAL |error| '|one|) '1) ('T '-1))) + (COND + ((AND (BOOT-EQUAL |m| '5) (BOOT-EQUAL |n| '3)) + (|f01qcfDefaultSolve| |htPage| |lda| |ifail|)) + ('T + (SPADLET |matList| + (PROG (G166480) + (SPADLET G166480 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |lda|) G166480) + (SEQ (EXIT + (SETQ G166480 + (APPEND G166480 + (|f01qcfSolve,f| |i| |n|))))))))) + (SPADLET |equationPart| + (CONS '(|domainConditions| + (|isDomain| P + (|Polynomial| |$EmptyMode|)) + (|isDomain| S (|String|)) + (|isDomain| F (|Float|)) + (|isDomain| PI (|PositiveInteger|))) + |matList|)) + (SPADLET |page| + (|htInitPage| + '|F01QCF - QR factorization or real m by n matrix (m \\htbitmap{great=} n)| + NIL)) + (|htSay| (MAKESTRING + "\\newline \\menuitemstyle{}\\tab{2} Enter values of {\\it A}: ")) + (|htSay| (MAKESTRING "\\newline \\tab{2} ")) + (|htMakePage| |equationPart|) + (|htSay| (MAKESTRING "\\blankline ")) + (|htMakeDoneButton| (MAKESTRING "Continue") + '|f01qcfGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|m| |m|) + (|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() + +(DEFUN |f01qcfDefaultSolve| (|htPage| |lda| |ifail|) + (declare (ignore |lda|)) + (PROG (|n| |m| |page|) + (RETURN + (PROGN + (SPADLET |n| '3) + (SPADLET |m| '5) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "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| (MAKESTRING "Continue") '|f01qcfGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|m| |m|) + (|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 + +(DEFUN |f01qcfGen| (|htPage|) + (PROG (|n| |m| |lda| |ifail| |alist| |elm| |y| |matform| |rowList| + |matstring| |prefix|) + (RETURN + (SEQ (PROGN + (SPADLET |n| (|htpProperty| |htPage| '|n|)) + (SPADLET |m| (|htpProperty| |htPage| '|m|)) + (SPADLET |lda| |m|) + (SPADLET |ifail| (|htpProperty| |htPage| '|ifail|)) + (SPADLET |alist| (|htpInputAreaAlist| |htPage|)) + (SPADLET |y| |alist|) + (SPADLET |y| (REVERSE |y|)) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |lda|) NIL) + (SEQ (EXIT (PROGN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |n|) NIL) + (SEQ (EXIT + (PROGN + (SPADLET |elm| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |rowList| + (APPEND |rowList| + (CONS |elm| NIL))) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |matform| + (APPEND |matform| + (CONS |rowList| NIL))) + (SPADLET |rowList| NIL))))) + (SPADLET |matstring| + (|bcwords2liststring| + (PROG (G166535) + (SPADLET G166535 NIL) + (RETURN + (DO ((G166540 |matform| + (CDR G166540)) + (|x| NIL)) + ((OR (ATOM G166540) + (PROGN + (SETQ |x| (CAR G166540)) + NIL)) + (NREVERSE0 G166535)) + (SEQ (EXIT + (SETQ G166535 + (CONS (|bcwords2liststring| |x|) + G166535))))))))) + (SPADLET |prefix| + (STRCONC (MAKESTRING "f01qcf(") (STRINGIMAGE |m|) + '|, | (STRINGIMAGE |n|) '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |lda|) '|, | + |matstring| '|, |)) + (SPADLET |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() + +(DEFUN |f01qdf| () + (PROGN + (|htInitPage| + (MAKESTRING + "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 \\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}" |notrans|) + (" " " {\\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" |ina|) + (" " + " 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| (MAKESTRING "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() + +(DEFUN |f01qdfSolve,ga| (|i| |j|) + (PROG (|anam|) + (RETURN + (SEQ (SPADLET |anam| + (INTERN (STRCONC (MAKESTRING "a") (STRINGIMAGE |i|) + (STRINGIMAGE |j|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 6 + (CONS '|0.0| + (CONS |anam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |f01qdfSolve,fa| (|i| |n|) + (PROG (|prefix| |labelList|) + (RETURN + (SEQ (SPADLET |labelList| + (PROG (G166583) + (SPADLET G166583 NIL) + (RETURN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |n|) G166583) + (SEQ (EXIT (SETQ G166583 + (APPEND G166583 + (|f01qdfSolve,ga| |i| |j|))))))))) + (SPADLET |prefix| (MAKESTRING "\\newline \\tab{2} ")) + (EXIT (SPADLET |labelList| + (CONS (CONS '|text| |prefix|) |labelList|))))))) + +(DEFUN |f01qdfSolve,gb| (|i| |j|) + (PROG (|bnam|) + (RETURN + (SEQ (SPADLET |bnam| + (INTERN (STRCONC (MAKESTRING "b") (STRINGIMAGE |i|) + (STRINGIMAGE |j|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 6 + (CONS '|0.0| + (CONS |bnam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |f01qdfSolve,fb| (|i| |ncolb|) + (PROG (|prefix| |labelList|) + (RETURN + (SEQ (SPADLET |labelList| + (PROG (G166606) + (SPADLET G166606 NIL) + (RETURN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |ncolb|) G166606) + (SEQ (EXIT (SETQ G166606 + (APPEND G166606 + (|f01qdfSolve,gb| |i| |j|))))))))) + (SPADLET |prefix| (MAKESTRING "\\newline \\tab{2} ")) + (EXIT (SPADLET |labelList| + (CONS (CONS '|text| |prefix|) |labelList|))))))) + +(DEFUN |f01qdfSolve,fz| (|i|) + (PROG (|znam|) + (RETURN + (SEQ (SPADLET |znam| + (INTERN (STRCONC (MAKESTRING "z") + (STRINGIMAGE |i|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 6 + (CONS '|0.0| + (CONS |znam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |f01qdfSolve| (|htPage|) + (PROG (|m| |n| |lda| |ldb| |ncolb| |operation| |trans| |elements| + |wheret| |error| |ifail| |matList| |bList| |prefix| + |zList| |equationPart| |page|) + (declare (special |$EmptyMode| |$bcParseOnly|)) + (RETURN + (SEQ (PROGN + (SPADLET |m| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|m|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|m|))))) + (SPADLET |n| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|n|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|n|))))) + (SPADLET |lda| |m|) + (SPADLET |ldb| |m|) + (SPADLET |ncolb| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| + '|ncolb|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|ncolb|))))) + (SPADLET |operation| (|htpButtonValue| |htPage| '|trans|)) + (SPADLET |trans| + (COND + ((BOOT-EQUAL |operation| '|notrans|) + (MAKESTRING "n")) + ('T (MAKESTRING "t")))) + (SPADLET |elements| (|htpButtonValue| |htPage| '|wheret|)) + (SPADLET |wheret| + (COND + ((BOOT-EQUAL |elements| '|ina|) + (MAKESTRING "i")) + ('T (MAKESTRING "s")))) + (SPADLET |error| (|htpButtonValue| |htPage| '|ifail|)) + (SPADLET |ifail| + (COND ((BOOT-EQUAL |error| '|one|) '1) ('T '-1))) + (COND + ((AND (BOOT-EQUAL |m| '5) (BOOT-EQUAL |n| '3) + (BOOT-EQUAL |ncolb| '2)) + (|f01qdfDefaultSolve| |htPage| |lda| |ldb| |trans| + |wheret| |ifail|)) + ('T + (SPADLET |matList| + (PROG (G166629) + (SPADLET G166629 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |lda|) G166629) + (SEQ (EXIT + (SETQ G166629 + (APPEND G166629 + (|f01qdfSolve,fa| |i| |n|))))))))) + (SPADLET |bList| + (PROG (G166637) + (SPADLET G166637 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |ldb|) G166637) + (SEQ (EXIT + (SETQ G166637 + (APPEND G166637 + (|f01qdfSolve,fb| |i| |ncolb|))))))))) + (SPADLET |prefix| + '|\\blankline \\menuitemstyle{}\\tab{2} Enter values of {\\it B}: |) + (SPADLET |bList| + (CONS (CONS '|text| |prefix|) |bList|)) + (SPADLET |zList| + (PROG (G166645) + (SPADLET G166645 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |n|) G166645) + (SEQ (EXIT + (SETQ G166645 + (APPEND G166645 + (|f01qdfSolve,fz| |i|))))))))) + (SPADLET |prefix| + '|\\blankline \\menuitemstyle{}\\tab{2} Enter values of \\zeta |) + (SPADLET |prefix| + (STRCONC |prefix| + '|(if required): \\newline \\tab{2}|)) + (SPADLET |zList| + (CONS (CONS '|text| |prefix|) |zList|)) + (SPADLET |equationPart| + (CONS '(|domainConditions| + (|isDomain| P + (|Polynomial| |$EmptyMode|)) + (|isDomain| S (|String|)) + (|isDomain| F (|Float|)) + (|isDomain| PI (|PositiveInteger|))) + (APPEND |matList| + (APPEND |bList| |zList|)))) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "F01QDF - Operations with orthogonal matrices, compute {\\it QB} or \\htbitmap{f01qdf} after factorization by F01QCF or F01QDF") + NIL)) + (|htSay| (MAKESTRING + "\\newline \\menuitemstyle{}\\tab{2} Enter values of {\\it A}: ")) + (|htSay| (MAKESTRING "\\newline \\tab{2} ")) + (|htMakePage| |equationPart|) + (|htSay| (MAKESTRING "\\blankline ")) + (|htMakeDoneButton| (MAKESTRING "Continue") + '|f01qdfGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|m| |m|) + (|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() + +(DEFUN |f01qdfDefaultSolve| (|htPage| |lda| |ldb| |trans| |wheret| |ifail|) + (declare (ignore |lda| |ldb|)) + (PROG (|n| |m| |ncolb| |page|) + (RETURN + (PROGN + (SPADLET |n| '3) + (SPADLET |m| '5) + (SPADLET |ncolb| '2) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "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| (MAKESTRING "Continue") '|f01qdfGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|m| |m|) + (|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 + +(DEFUN |f01qdfGen| (|htPage|) + (PROG (|n| |m| |lda| |ldb| |ncolb| |trans| |wheret| |ifail| |alist| + |left| |zetalist| |zetastring| |matform| |matstring| |elm| + |y| |bform| |rowList| |bstring| |prefix|) + (RETURN + (SEQ (PROGN + (SPADLET |n| (|htpProperty| |htPage| '|n|)) + (SPADLET |m| (|htpProperty| |htPage| '|m|)) + (SPADLET |lda| |m|) + (SPADLET |ldb| |m|) + (SPADLET |ncolb| (|htpProperty| |htPage| '|ncolb|)) + (SPADLET |trans| (|htpProperty| |htPage| '|trans|)) + (SPADLET |wheret| (|htpProperty| |htPage| '|wheret|)) + (SPADLET |ifail| (|htpProperty| |htPage| '|ifail|)) + (SPADLET |alist| (|htpInputAreaAlist| |htPage|)) + (SPADLET |y| |alist|) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |n|) NIL) + (SEQ (EXIT (PROGN + (SPADLET |left| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |y| (CDR |y|)) + (SPADLET |zetalist| + (CONS |left| |zetalist|)))))) + (SPADLET |zetastring| (|bcwords2liststring| |zetalist|)) + (SPADLET |y| (REVERSE |y|)) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |lda|) NIL) + (SEQ (EXIT (PROGN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |n|) NIL) + (SEQ (EXIT + (PROGN + (SPADLET |elm| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |rowList| + (APPEND |rowList| + (CONS |elm| NIL))) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |matform| + (APPEND |matform| + (CONS |rowList| NIL))) + (SPADLET |rowList| NIL))))) + (SPADLET |matstring| + (|bcwords2liststring| + (PROG (G166728) + (SPADLET G166728 NIL) + (RETURN + (DO ((G166733 |matform| + (CDR G166733)) + (|x| NIL)) + ((OR (ATOM G166733) + (PROGN + (SETQ |x| (CAR G166733)) + NIL)) + (NREVERSE0 G166728)) + (SEQ (EXIT + (SETQ G166728 + (CONS (|bcwords2liststring| |x|) + G166728))))))))) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |ldb|) NIL) + (SEQ (EXIT (PROGN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |ncolb|) NIL) + (SEQ (EXIT + (PROGN + (SPADLET |elm| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |rowList| + (APPEND |rowList| + (CONS |elm| NIL))) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |bform| + (APPEND |bform| + (CONS |rowList| NIL))) + (SPADLET |rowList| NIL))))) + (SPADLET |bstring| + (|bcwords2liststring| + (PROG (G166764) + (SPADLET G166764 NIL) + (RETURN + (DO ((G166769 |bform| (CDR G166769)) + (|x| NIL)) + ((OR (ATOM G166769) + (PROGN + (SETQ |x| (CAR G166769)) + NIL)) + (NREVERSE0 G166764)) + (SEQ (EXIT + (SETQ G166764 + (CONS (|bcwords2liststring| |x|) + G166764))))))))) + (SPADLET |prefix| + (STRCONC (MAKESTRING "f01qdf(\"") |trans| '|","| + |wheret| '|",| (STRINGIMAGE |m|) '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |n|) '|, | + |matstring| '|, | (STRINGIMAGE |lda|))) + (SPADLET |prefix| + (STRCONC |prefix| '|,[| |zetastring| '|],| + (STRINGIMAGE |ncolb|) '|, |)) + (SPADLET |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() + +(DEFUN |f01qef| () + (PROGN + (|htInitPage| + (MAKESTRING + "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| . "Number columns of matrix Q {\\it ncolq}: ") + (|text| . "\\newline \\tab{2} ") + (|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| (MAKESTRING "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() + +(DEFUN |f01qefSolve,ga| (|i| |j|) + (PROG (|anam|) + (RETURN + (SEQ (SPADLET |anam| + (INTERN (STRCONC (MAKESTRING "a") (STRINGIMAGE |i|) + (STRINGIMAGE |j|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 7 + (CONS '|0.0| + (CONS |anam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |f01qefSolve,fa| (|i| |ncolq|) + (PROG (|prefix| |labelList|) + (RETURN + (SEQ (SPADLET |labelList| + (PROG (G166827) + (SPADLET G166827 NIL) + (RETURN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |ncolq|) G166827) + (SEQ (EXIT (SETQ G166827 + (APPEND G166827 + (|f01qefSolve,ga| |i| |j|))))))))) + (SPADLET |prefix| (MAKESTRING "\\newline ")) + (EXIT (SPADLET |labelList| + (CONS (CONS '|text| |prefix|) |labelList|))))))) + +(DEFUN |f01qefSolve,fz| (|i|) + (PROG (|znam|) + (RETURN + (SEQ (SPADLET |znam| + (INTERN (STRCONC (MAKESTRING "z") + (STRINGIMAGE |i|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 7 + (CONS '|0.0| + (CONS |znam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |f01qefSolve| (|htPage|) + (PROG (|m| |n| |lda| |ncolq| |elements| |wheret| |error| |ifail| + |matList| |prefix| |zList| |equationPart| |page|) + (declare (special |$EmptyMode| |$bcParseOnly|)) + (RETURN + (SEQ (PROGN + (SPADLET |m| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|m|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|m|))))) + (SPADLET |n| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|n|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|n|))))) + (SPADLET |lda| |m|) + (SPADLET |ncolq| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| + '|ncolq|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|ncolq|))))) + (SPADLET |elements| (|htpButtonValue| |htPage| '|wheret|)) + (SPADLET |wheret| + (COND + ((BOOT-EQUAL |elements| '|initial|) + (MAKESTRING "i")) + ('T (MAKESTRING "s")))) + (SPADLET |error| (|htpButtonValue| |htPage| '|ifail|)) + (SPADLET |ifail| + (COND ((BOOT-EQUAL |error| '|one|) '1) ('T '-1))) + (COND + ((AND (BOOT-EQUAL |m| '5) (BOOT-EQUAL |n| '3) + (BOOT-EQUAL |ncolq| '5)) + (|f01qefDefaultSolve| |htPage| |lda| |wheret| |ifail|)) + ('T + (SPADLET |matList| + (PROG (G166850) + (SPADLET G166850 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |lda|) G166850) + (SEQ (EXIT + (SETQ G166850 + (APPEND G166850 + (|f01qefSolve,fa| |i| |ncolq|))))))))) + (SPADLET |zList| + (PROG (G166858) + (SPADLET G166858 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |n|) G166858) + (SEQ (EXIT + (SETQ G166858 + (APPEND G166858 + (|f01qefSolve,fz| |i|))))))))) + (SPADLET |prefix| + '|\\blankline \\menuitemstyle{}\\tab{2} Enter values of \\zeta |) + (SPADLET |prefix| + (STRCONC |prefix| + '|(if required): \\newline |)) + (SPADLET |zList| + (CONS (CONS '|text| |prefix|) |zList|)) + (SPADLET |equationPart| + (CONS '(|domainConditions| + (|isDomain| P + (|Polynomial| |$EmptyMode|)) + (|isDomain| S (|String|)) + (|isDomain| F (|Float|)) + (|isDomain| PI (|PositiveInteger|))) + (APPEND |matList| |zList|))) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "F01QEF - Operations with orthogonal matrices, form columns of {\\it Q} after factorization by F01QCF or F01QFF") + NIL)) + (|htSay| (MAKESTRING + "\\newline \\menuitemstyle{}\\tab{2} Enter values of {\\it Q}: ")) + (|htSay| (MAKESTRING "\\newline ")) + (|htMakePage| |equationPart|) + (|htSay| (MAKESTRING "\\blankline ")) + (|htMakeDoneButton| (MAKESTRING "Continue") + '|f01qefGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|m| |m|) + (|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() + +(DEFUN |f01qefDefaultSolve| (|htPage| |lda| |wheret| |ifail|) + (declare (ignore |lda|)) + (PROG (|n| |m| |ncolq| |page|) + (RETURN + (PROGN + (SPADLET |n| '3) + (SPADLET |m| '5) + (SPADLET |ncolq| '5) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "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| (MAKESTRING "Continue") '|f01qefGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|m| |m|) + (|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 + +(DEFUN |f01qefGen| (|htPage|) + (PROG (|n| |m| |lda| |ncolq| |wheret| |ifail| |alist| |left| + |zetalist| |zetastring| |elm| |y| |matform| |rowList| + |matstring| |prefix|) + (RETURN + (SEQ (PROGN + (SPADLET |n| (|htpProperty| |htPage| '|n|)) + (SPADLET |m| (|htpProperty| |htPage| '|m|)) + (SPADLET |lda| |m|) + (SPADLET |ncolq| (|htpProperty| |htPage| '|ncolq|)) + (SPADLET |wheret| (|htpProperty| |htPage| '|wheret|)) + (SPADLET |ifail| (|htpProperty| |htPage| '|ifail|)) + (SPADLET |alist| (|htpInputAreaAlist| |htPage|)) + (SPADLET |y| |alist|) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |n|) NIL) + (SEQ (EXIT (PROGN + (SPADLET |left| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |y| (CDR |y|)) + (SPADLET |zetalist| + (CONS |left| |zetalist|)))))) + (SPADLET |zetastring| (|bcwords2liststring| |zetalist|)) + (SPADLET |y| (REVERSE |y|)) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |lda|) NIL) + (SEQ (EXIT (PROGN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |ncolq|) NIL) + (SEQ (EXIT + (PROGN + (SPADLET |elm| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |rowList| + (APPEND |rowList| + (CONS |elm| NIL))) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |matform| + (APPEND |matform| + (CONS |rowList| NIL))) + (SPADLET |rowList| NIL))))) + (SPADLET |matstring| + (|bcwords2liststring| + (PROG (G166932) + (SPADLET G166932 NIL) + (RETURN + (DO ((G166937 |matform| + (CDR G166937)) + (|x| NIL)) + ((OR (ATOM G166937) + (PROGN + (SETQ |x| (CAR G166937)) + NIL)) + (NREVERSE0 G166932)) + (SEQ (EXIT + (SETQ G166932 + (CONS (|bcwords2liststring| |x|) + G166932))))))))) + (SPADLET |prefix| + (STRCONC (MAKESTRING "f01qef(\"") |wheret| '|",| + (STRINGIMAGE |m|) '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |n|) '|, | + (STRINGIMAGE |lda|) '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |ncolq|) '|,[| + |zetastring| '|],|)) + (SPADLET |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() + +(pprint '(DEFUN |f01rcf| NIL (PROGN (|htInitPage| (MAKESTRING "F01RCF - {\\it QR} factorization of complex {\\it m} by {\\it n} matrix (m \\htbitmap{great=} n)") NIL) (|htMakePage| (QUOTE ((|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 \\tab{2} ") (|text| . "Ifail value: ") (|radioButtons| |ifail| ("" " -1, Print error messages" |minusOne|) ("" " 1, Suppress error messages" |one|))))) (|htMakeDoneButton| (MAKESTRING "Continue") (QUOTE |f01rcfSolve|)) (|htShowPage|))) +) + +(DEFUN |f01rcf| () + (PROGN + (|htInitPage| + (MAKESTRING + "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 \\tab{2} ") (|text| . "Ifail value: ") + (|radioButtons| |ifail| + ("" " -1, Print error messages" |minusOne|) + ("" " 1, Suppress error messages" |one|)))) + (|htMakeDoneButton| (MAKESTRING "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() + +(DEFUN |f01rcfSolve,ga| (|i| |j|) + (PROG (|anam|) + (RETURN + (SEQ (SPADLET |anam| + (INTERN (STRCONC (MAKESTRING "a") (STRINGIMAGE |i|) + (STRINGIMAGE |j|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 16 + (CONS '|0.0 + 0.0*%i| + (CONS |anam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |f01rcfSolve,fa| (|i| |n|) + (PROG (|prefix| |labelList|) + (RETURN + (SEQ (SPADLET |labelList| + (PROG (G166984) + (SPADLET G166984 NIL) + (RETURN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |n|) G166984) + (SEQ (EXIT (SETQ G166984 + (APPEND G166984 + (|f01rcfSolve,ga| |i| |j|))))))))) + (SPADLET |prefix| (MAKESTRING "\\newline \\tab{2} ")) + (EXIT (SPADLET |labelList| + (CONS (CONS '|text| |prefix|) |labelList|))))))) + +(DEFUN |f01rcfSolve| (|htPage|) + (PROG (|m| |n| |lda| |error| |ifail| |matList| |equationPart| |page|) + (declare (special |$EmptyMode| |$bcParseOnly|)) + (RETURN + (SEQ (PROGN + (SPADLET |m| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|m|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|m|))))) + (SPADLET |n| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|n|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|n|))))) + (SPADLET |lda| |m|) + (SPADLET |error| (|htpButtonValue| |htPage| '|ifail|)) + (SPADLET |ifail| + (COND ((BOOT-EQUAL |error| '|one|) '1) ('T '-1))) + (COND + ((AND (BOOT-EQUAL |m| '5) (BOOT-EQUAL |n| '3)) + (|f01rcfDefaultSolve| |htPage| |ifail|)) + ('T + (SPADLET |matList| + (PROG (G167001) + (SPADLET G167001 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |lda|) G167001) + (SEQ (EXIT + (SETQ G167001 + (APPEND G167001 + (|f01rcfSolve,fa| |i| |n|))))))))) + (SPADLET |equationPart| + (CONS '(|domainConditions| + (|isDomain| P + (|Polynomial| |$EmptyMode|)) + (|isDomain| S (|String|)) + (|isDomain| F (|Float|)) + (|isDomain| PI (|PositiveInteger|))) + |matList|)) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "F01RCF - {\\it QR} factorization of complex {\\it m} by {\\it n} matrix (m \\htbitmap{great=} n)") + NIL)) + (|htSay| (MAKESTRING + "\\newline \\menuitemstyle{}\\tab{2} Enter values of {\\it A}: ")) + (|htSay| (MAKESTRING "\\newline \\tab{2} ")) + (|htMakePage| |equationPart|) + (|htSay| (MAKESTRING "\\blankline ")) + (|htMakeDoneButton| (MAKESTRING "Continue") + '|f01rcfGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|m| |m|) + (|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() + +(DEFUN |f01rcfDefaultSolve| (|htPage| |ifail|) + (PROG (|n| |m| |lda| |page|) + (RETURN + (PROGN + (SPADLET |n| '3) + (SPADLET |m| '5) + (SPADLET |lda| '5) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "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| (MAKESTRING "Continue") '|f01rcfGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|m| |m|) + (|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,")") + +(DEFUN |f01rcfGen| (|htPage|) + (PROG (|n| |m| |lda| |ifail| |alist| |elm| |y| |matform| |rowList| + |matstring| |prefix|) + (RETURN + (SEQ (PROGN + (SPADLET |n| (|htpProperty| |htPage| '|n|)) + (SPADLET |m| (|htpProperty| |htPage| '|m|)) + (SPADLET |lda| |m|) + (SPADLET |ifail| (|htpProperty| |htPage| '|ifail|)) + (SPADLET |alist| (|htpInputAreaAlist| |htPage|)) + (SPADLET |y| |alist|) + (SPADLET |y| (REVERSE |y|)) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |lda|) NIL) + (SEQ (EXIT (PROGN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |n|) NIL) + (SEQ (EXIT + (PROGN + (SPADLET |elm| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |rowList| + (APPEND |rowList| + (CONS |elm| NIL))) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |matform| + (APPEND |matform| + (CONS |rowList| NIL))) + (SPADLET |rowList| NIL))))) + (SPADLET |matstring| + (|bcwords2liststring| + (PROG (G167057) + (SPADLET G167057 NIL) + (RETURN + (DO ((G167062 |matform| + (CDR G167062)) + (|x| NIL)) + ((OR (ATOM G167062) + (PROGN + (SETQ |x| (CAR G167062)) + NIL)) + (NREVERSE0 G167057)) + (SEQ (EXIT + (SETQ G167057 + (CONS (|bcwords2liststring| |x|) + G167057))))))))) + (SPADLET |prefix| + (STRCONC (MAKESTRING "f01rcf(") (STRINGIMAGE |m|) + '|, | (STRINGIMAGE |n|) '|, |)) + (SPADLET |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() + +(DEFUN |f01rdf| () + (PROGN + (|htInitPage| + (MAKESTRING + "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 \\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}" |notrans|) + (" " + " {\\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" |ina|) + (" " " 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| (MAKESTRING "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() + +(DEFUN |f01rdfSolve,ga| (|i| |j|) + (PROG (|anam|) + (RETURN + (SEQ (SPADLET |anam| + (INTERN (STRCONC (MAKESTRING "a") (STRINGIMAGE |i|) + (STRINGIMAGE |j|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 16 + (CONS '|0.0 + 0.0*%i| + (CONS |anam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |f01rdfSolve,fa| (|i| |n|) + (PROG (|prefix| |labelList|) + (RETURN + (SEQ (SPADLET |labelList| + (PROG (G167104) + (SPADLET G167104 NIL) + (RETURN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |n|) G167104) + (SEQ (EXIT (SETQ G167104 + (APPEND G167104 + (|f01rdfSolve,ga| |i| |j|))))))))) + (SPADLET |prefix| (MAKESTRING "\\newline \\tab{2} ")) + (EXIT (SPADLET |labelList| + (CONS (CONS '|text| |prefix|) |labelList|))))))) + +(DEFUN |f01rdfSolve,gb| (|i| |j|) + (PROG (|bnam|) + (RETURN + (SEQ (SPADLET |bnam| + (INTERN (STRCONC (MAKESTRING "b") (STRINGIMAGE |i|) + (STRINGIMAGE |j|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 16 + (CONS '|0.0 + 0.0*%i| + (CONS |bnam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |f01rdfSolve,fb| (|i| |ncolb|) + (PROG (|prefix| |labelList|) + (RETURN + (SEQ (SPADLET |labelList| + (PROG (G167127) + (SPADLET G167127 NIL) + (RETURN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |ncolb|) G167127) + (SEQ (EXIT (SETQ G167127 + (APPEND G167127 + (|f01rdfSolve,gb| |i| |j|))))))))) + (SPADLET |prefix| (MAKESTRING "\\newline \\tab{2} ")) + (EXIT (SPADLET |labelList| + (CONS (CONS '|text| |prefix|) |labelList|))))))) + +(DEFUN |f01rdfSolve,fz| (|i|) + (PROG (|znam|) + (RETURN + (SEQ (SPADLET |znam| + (INTERN (STRCONC (MAKESTRING "z") + (STRINGIMAGE |i|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 16 + (CONS '|0.0| + (CONS |znam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |f01rdfSolve| (|htPage|) + (PROG (|m| |n| |lda| |ldb| |ncolb| |operation| |trans| |elements| + |wheret| |error| |ifail| |matList| |bList| |prefix| + |zList| |equationPart| |page|) + (declare (special |$EmptyMode| |$bcParseOnly|)) + (RETURN + (SEQ (PROGN + (SPADLET |m| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|m|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|m|))))) + (SPADLET |n| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|n|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|n|))))) + (SPADLET |lda| |m|) + (SPADLET |ldb| |m|) + (SPADLET |ncolb| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| + '|ncolb|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|ncolb|))))) + (SPADLET |operation| (|htpButtonValue| |htPage| '|trans|)) + (SPADLET |trans| + (COND + ((BOOT-EQUAL |operation| '|notrans|) + (MAKESTRING "n")) + ('T (MAKESTRING "c")))) + (SPADLET |elements| (|htpButtonValue| |htPage| '|wheret|)) + (SPADLET |wheret| + (COND + ((BOOT-EQUAL |elements| '|ina|) + (MAKESTRING "i")) + ('T (MAKESTRING "c")))) + (SPADLET |error| (|htpButtonValue| |htPage| '|ifail|)) + (SPADLET |ifail| + (COND ((BOOT-EQUAL |error| '|one|) '1) ('T '-1))) + (COND + ((AND (BOOT-EQUAL |m| '5) (BOOT-EQUAL |n| '3) + (BOOT-EQUAL |ncolb| '2)) + (|f01rdfDefaultSolve| |htPage| |lda| |ldb| |trans| + |wheret| |ifail|)) + ('T + (SPADLET |matList| + (PROG (G167150) + (SPADLET G167150 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |lda|) G167150) + (SEQ (EXIT + (SETQ G167150 + (APPEND G167150 + (|f01rdfSolve,fa| |i| |n|))))))))) + (SPADLET |bList| + (PROG (G167158) + (SPADLET G167158 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |ldb|) G167158) + (SEQ (EXIT + (SETQ G167158 + (APPEND G167158 + (|f01rdfSolve,fb| |i| |ncolb|))))))))) + (SPADLET |prefix| + '|\\blankline \\menuitemstyle{}\\tab{2} Enter values of {\\it B}: |) + (SPADLET |bList| + (CONS (CONS '|text| |prefix|) |bList|)) + (SPADLET |zList| + (PROG (G167166) + (SPADLET G167166 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |n|) G167166) + (SEQ (EXIT + (SETQ G167166 + (APPEND G167166 + (|f01rdfSolve,fz| |i|))))))))) + (SPADLET |prefix| + '|\\blankline \\menuitemstyle{}\\tab{2} Enter values of \\theta |) + (SPADLET |prefix| + (STRCONC |prefix| + '|(if required): \\newline \\tab{2}|)) + (SPADLET |zList| + (CONS (CONS '|text| |prefix|) |zList|)) + (SPADLET |equationPart| + (CONS '(|domainConditions| + (|isDomain| P + (|Polynomial| |$EmptyMode|)) + (|isDomain| S (|String|)) + (|isDomain| F (|Float|)) + (|isDomain| PI (|PositiveInteger|))) + (APPEND |matList| + (APPEND |bList| |zList|)))) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "F01RDF - Operations with orthogonal matrices, compute {\\it QB} or \\htbitmap{f01rdf} after factorization by F01QCF or F01RDF") + NIL)) + (|htSay| (MAKESTRING + "\\newline \\menuitemstyle{}\\tab{2} Enter values of {\\it A}: ")) + (|htSay| (MAKESTRING "\\newline \\tab{2} ")) + (|htMakePage| |equationPart|) + (|htSay| (MAKESTRING "\\blankline ")) + (|htMakeDoneButton| (MAKESTRING "Continue") + '|f01rdfGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|m| |m|) + (|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() + +(DEFUN |f01rdfDefaultSolve| (|htPage| |lda| |ldb| |trans| |wheret| |ifail|) + (declare (ignore |lda| |ldb|)) + (PROG (|n| |m| |ncolb| |page|) + (RETURN + (PROGN + (SPADLET |n| '3) + (SPADLET |m| '5) + (SPADLET |ncolb| '2) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "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| (MAKESTRING "Continue") '|f01rdfGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|m| |m|) + (|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 + +(DEFUN |f01rdfGen| (|htPage|) + (PROG (|n| |m| |lda| |ldb| |ncolb| |trans| |wheret| |ifail| |alist| + |left| |zetalist| |zetastring| |matform| |matstring| |elm| + |y| |bform| |rowList| |bstring| |prefix|) + (RETURN + (SEQ (PROGN + (SPADLET |n| (|htpProperty| |htPage| '|n|)) + (SPADLET |m| (|htpProperty| |htPage| '|m|)) + (SPADLET |lda| |m|) + (SPADLET |ldb| |m|) + (SPADLET |ncolb| (|htpProperty| |htPage| '|ncolb|)) + (SPADLET |trans| (|htpProperty| |htPage| '|trans|)) + (SPADLET |wheret| (|htpProperty| |htPage| '|wheret|)) + (SPADLET |ifail| (|htpProperty| |htPage| '|ifail|)) + (SPADLET |alist| (|htpInputAreaAlist| |htPage|)) + (SPADLET |y| |alist|) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |n|) NIL) + (SEQ (EXIT (PROGN + (SPADLET |left| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |y| (CDR |y|)) + (SPADLET |zetalist| + (CONS |left| |zetalist|)))))) + (SPADLET |zetastring| (|bcwords2liststring| |zetalist|)) + (SPADLET |y| (REVERSE |y|)) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |lda|) NIL) + (SEQ (EXIT (PROGN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |n|) NIL) + (SEQ (EXIT + (PROGN + (SPADLET |elm| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |rowList| + (APPEND |rowList| + (CONS |elm| NIL))) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |matform| + (APPEND |matform| + (CONS |rowList| NIL))) + (SPADLET |rowList| NIL))))) + (SPADLET |matstring| + (|bcwords2liststring| + (PROG (G167249) + (SPADLET G167249 NIL) + (RETURN + (DO ((G167254 |matform| + (CDR G167254)) + (|x| NIL)) + ((OR (ATOM G167254) + (PROGN + (SETQ |x| (CAR G167254)) + NIL)) + (NREVERSE0 G167249)) + (SEQ (EXIT + (SETQ G167249 + (CONS (|bcwords2liststring| |x|) + G167249))))))))) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |ldb|) NIL) + (SEQ (EXIT (PROGN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |ncolb|) NIL) + (SEQ (EXIT + (PROGN + (SPADLET |elm| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |rowList| + (APPEND |rowList| + (CONS |elm| NIL))) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |bform| + (APPEND |bform| + (CONS |rowList| NIL))) + (SPADLET |rowList| NIL))))) + (SPADLET |bstring| + (|bcwords2liststring| + (PROG (G167285) + (SPADLET G167285 NIL) + (RETURN + (DO ((G167290 |bform| (CDR G167290)) + (|x| NIL)) + ((OR (ATOM G167290) + (PROGN + (SETQ |x| (CAR G167290)) + NIL)) + (NREVERSE0 G167285)) + (SEQ (EXIT + (SETQ G167285 + (CONS (|bcwords2liststring| |x|) + G167285))))))))) + (SPADLET |prefix| + (STRCONC (MAKESTRING "f01rdf(\"") |trans| '|","| + |wheret| '|",| (STRINGIMAGE |m|) '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |n|) '|, | + |matstring| '|, | (STRINGIMAGE |lda|))) + (SPADLET |prefix| + (STRCONC |prefix| '|,[| |zetastring| '|],| + (STRINGIMAGE |ncolb|) '|, |)) + (SPADLET |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() + +(DEFUN |f01ref| () + (PROGN + (|htInitPage| + (MAKESTRING + "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 \\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" |ina|)) + (|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| (MAKESTRING "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() + +(DEFUN |f01refSolve,ga| (|i| |j|) + (PROG (|anam|) + (RETURN + (SEQ (SPADLET |anam| + (INTERN (STRCONC (MAKESTRING "a") (STRINGIMAGE |i|) + (STRINGIMAGE |j|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 20 + (CONS '|0.0 + 0.0*%i| + (CONS |anam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |f01refSolve,fa| (|i| |n|) + (PROG (|prefix| |labelList|) + (RETURN + (SEQ (SPADLET |labelList| + (PROG (G167348) + (SPADLET G167348 NIL) + (RETURN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |n|) G167348) + (SEQ (EXIT (SETQ G167348 + (APPEND G167348 + (|f01refSolve,ga| |i| |j|))))))))) + (SPADLET |prefix| (MAKESTRING "\\newline \\tab{2} ")) + (EXIT (SPADLET |labelList| + (CONS (CONS '|text| |prefix|) |labelList|))))))) + +(DEFUN |f01refSolve,fz| (|i|) + (PROG (|znam|) + (RETURN + (SEQ (SPADLET |znam| + (INTERN (STRCONC (MAKESTRING "z") + (STRINGIMAGE |i|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 20 + (CONS '|0.0| + (CONS |znam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |f01refSolve| (|htPage|) + (PROG (|m| |n| |lda| |ncolq| |elements| |wheret| |error| |ifail| + |matList| |prefix| |zList| |equationPart| |page|) + (declare (special |$EmptyMode| |$bcParseOnly|)) + (RETURN + (SEQ (PROGN + (SPADLET |m| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|m|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|m|))))) + (SPADLET |n| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|n|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|n|))))) + (SPADLET |lda| |m|) + (SPADLET |ncolq| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| + '|ncolq|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|ncolq|))))) + (SPADLET |elements| (|htpButtonValue| |htPage| '|wheret|)) + (SPADLET |wheret| + (COND + ((BOOT-EQUAL |elements| '|ina|) + (MAKESTRING "i")) + ('T (MAKESTRING "s")))) + (SPADLET |error| (|htpButtonValue| |htPage| '|ifail|)) + (SPADLET |ifail| + (COND ((BOOT-EQUAL |error| '|one|) '1) ('T '-1))) + (COND + ((AND (BOOT-EQUAL |m| '5) (BOOT-EQUAL |n| '3) + (BOOT-EQUAL |ncolq| '2)) + (|f01refDefaultSolve| |htPage| |lda| |wheret| |ifail|)) + ('T + (SPADLET |matList| + (PROG (G167371) + (SPADLET G167371 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |lda|) G167371) + (SEQ (EXIT + (SETQ G167371 + (APPEND G167371 + (|f01refSolve,fa| |i| |n|))))))))) + (SPADLET |zList| + (PROG (G167379) + (SPADLET G167379 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |n|) G167379) + (SEQ (EXIT + (SETQ G167379 + (APPEND G167379 + (|f01refSolve,fz| |i|))))))))) + (SPADLET |prefix| + '|\\blankline \\menuitemstyle{}\\tab{2} Enter values of \\theta |) + (SPADLET |prefix| + (STRCONC |prefix| + '|(if required): \\newline \\tab{2}|)) + (SPADLET |zList| + (CONS (CONS '|text| |prefix|) |zList|)) + (SPADLET |equationPart| + (CONS '(|domainConditions| + (|isDomain| P + (|Polynomial| |$EmptyMode|)) + (|isDomain| S (|String|)) + (|isDomain| F (|Float|)) + (|isDomain| PI (|PositiveInteger|))) + (APPEND |matList| |zList|))) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "F01REF - Operations with unitary matrices, form columns of {\\it Q} after factorization by F01RCF") + NIL)) + (|htSay| (MAKESTRING + "\\newline \\menuitemstyle{}\\tab{2} Enter values of {\\it A}: ")) + (|htSay| (MAKESTRING "\\newline \\tab{2} ")) + (|htMakePage| |equationPart|) + (|htSay| (MAKESTRING "\\blankline ")) + (|htMakeDoneButton| (MAKESTRING "Continue") + '|f01refGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|m| |m|) + (|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() + +(DEFUN |f01refDefaultSolve| (|htPage| |lda| |wheret| |ifail|) + (declare (ignore |lda|)) + (PROG (|n| |m| |ncolq| |page|) + (RETURN + (PROGN + (SPADLET |n| '3) + (SPADLET |m| '5) + (SPADLET |ncolq| '2) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "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| (MAKESTRING "Continue") '|f01refGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|m| |m|) + (|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 + +(DEFUN |f01refGen| (|htPage|) + (PROG (|n| |m| |lda| |ncolq| |wheret| |ifail| |alist| |left| + |thetalist| |thetastring| |elm| |y| |matform| |rowList| + |matstring| |prefix|) + (RETURN + (SEQ (PROGN + (SPADLET |n| (|htpProperty| |htPage| '|n|)) + (SPADLET |m| (|htpProperty| |htPage| '|m|)) + (SPADLET |lda| |m|) + (SPADLET |ncolq| (|htpProperty| |htPage| '|ncolq|)) + (SPADLET |wheret| (|htpProperty| |htPage| '|wheret|)) + (SPADLET |ifail| (|htpProperty| |htPage| '|ifail|)) + (SPADLET |alist| (|htpInputAreaAlist| |htPage|)) + (SPADLET |y| |alist|) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |n|) NIL) + (SEQ (EXIT (PROGN + (SPADLET |left| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |y| (CDR |y|)) + (SPADLET |thetalist| + (CONS |left| |thetalist|)))))) + (SPADLET |thetastring| (|bcwords2liststring| |thetalist|)) + (SPADLET |y| (REVERSE |y|)) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |lda|) NIL) + (SEQ (EXIT (PROGN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |n|) NIL) + (SEQ (EXIT + (PROGN + (SPADLET |elm| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |rowList| + (APPEND |rowList| + (CONS |elm| NIL))) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |matform| + (APPEND |matform| + (CONS |rowList| NIL))) + (SPADLET |rowList| NIL))))) + (SPADLET |matstring| + (|bcwords2liststring| + (PROG (G167453) + (SPADLET G167453 NIL) + (RETURN + (DO ((G167458 |matform| + (CDR G167458)) + (|x| NIL)) + ((OR (ATOM G167458) + (PROGN + (SETQ |x| (CAR G167458)) + NIL)) + (NREVERSE0 G167453)) + (SEQ (EXIT + (SETQ G167453 + (CONS (|bcwords2liststring| |x|) + G167453))))))))) + (SPADLET |prefix| + (STRCONC (MAKESTRING "f01ref(\"") |wheret| '|",| + (STRINGIMAGE |m|) '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |n|) '|, | + (STRINGIMAGE |ncolq|) '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |lda|) '|,[| + |thetastring| '|],|)) + (SPADLET |prefix| + (STRCONC |prefix| |matstring| '|, | + (STRINGIMAGE |ifail|) '|)|)) + (|linkGen| |prefix|)))))) + +@ +\eject +\begin{thebibliography}{99} +\bibitem{1} nothing +\end{thebibliography} +\end{document}