From ab8cc85adde879fb963c94d15675783f2cf4b183 Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Tue, 14 Aug 2007 05:14:52 +0000
Subject: Initial population.

---
 src/algebra/formula.spad.pamphlet | 519 ++++++++++++++++++++++++++++++++++++++
 1 file changed, 519 insertions(+)
 create mode 100644 src/algebra/formula.spad.pamphlet

(limited to 'src/algebra/formula.spad.pamphlet')

diff --git a/src/algebra/formula.spad.pamphlet b/src/algebra/formula.spad.pamphlet
new file mode 100644
index 00000000..b5668638
--- /dev/null
+++ b/src/algebra/formula.spad.pamphlet
@@ -0,0 +1,519 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/algebra formula.spad}
+\author{Robert S. Sutor}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{domain FORMULA ScriptFormulaFormat}
+<<domain FORMULA ScriptFormulaFormat>>=
+)abbrev domain FORMULA ScriptFormulaFormat
+++ Author: Robert S. Sutor
+++ Date Created: 1987 through 1990
+++ Change History:
+++ Basic Operations: coerce, convert, display, epilogue,
+++   formula, new, prologue, setEpilogue!, setFormula!, setPrologue!
+++ Related Constructors: ScriptFormulaFormat1
+++ Also See: TexFormat
+++ AMS Classifications:
+++ Keywords: output, format, SCRIPT, BookMaster, formula
+++ References:
+++   SCRIPT Mathematical Formula Formatter User's Guide, SH20-6453,
+++   IBM Corporation, Publishing Systems Information Development,
+++   Dept. G68, P.O. Box 1900, Boulder, Colorado, USA 80301-9191.
+++ Description:
+++   \spadtype{ScriptFormulaFormat} provides a coercion from
+++   \spadtype{OutputForm} to IBM SCRIPT/VS Mathematical Formula Format.
+++   The basic SCRIPT formula format object consists of three parts:  a
+++   prologue, a formula part and an epilogue.  The functions
+++   \spadfun{prologue}, \spadfun{formula} and \spadfun{epilogue}
+++   extract these parts, respectively.  The central parts of the expression
+++   go into the formula part.  The other parts can be set
+++   (\spadfun{setPrologue!}, \spadfun{setEpilogue!}) so that contain the
+++   appropriate tags for printing.  For example, the prologue and
+++   epilogue might simply contain ":df."  and ":edf."  so that the
+++   formula section will be printed in display math mode.
+
+ScriptFormulaFormat(): public == private where
+  E      ==> OutputForm
+  I      ==> Integer
+  L      ==> List
+  S      ==> String
+
+  public == SetCategory with
+    coerce:   E -> %
+      ++ coerce(o) changes o in the standard output format to
+      ++ SCRIPT formula format.
+    convert:  (E,I) -> %
+      ++ convert(o,step) changes o in standard output format to
+      ++ SCRIPT formula format and also adds the given step number.
+      ++ This is useful if you want to create equations with given numbers
+      ++ or have the equation numbers correspond to the interpreter step
+      ++ numbers.
+    display:  (%, I) -> Void
+      ++ display(t,width) outputs the formatted code t so that each
+      ++ line has length less than or equal to \spadvar{width}.
+    display:  % -> Void
+      ++ display(t) outputs the formatted code t so that each
+      ++ line has length less than or equal to the value set by
+      ++ the system command \spadsyscom{set output length}.
+    epilogue: % -> L S
+      ++ epilogue(t) extracts the epilogue section of a formatted object t.
+    formula:      % -> L S
+      ++ formula(t) extracts the formula section of a formatted object t.
+    new:      () -> %
+      ++ new() create a new, empty object. Use \spadfun{setPrologue!},
+      ++ \spadfun{setFormula!} and \spadfun{setEpilogue!} to set the
+      ++ various components of this object.
+    prologue: % -> L S
+      ++ prologue(t) extracts the prologue section of a formatted object t.
+    setEpilogue!: (%, L S) -> L S
+      ++ setEpilogue!(t,strings) sets the epilogue section of a
+      ++ formatted object t to strings.
+    setFormula!:  (%, L S) -> L S
+      ++ setFormula!(t,strings) sets the formula section of a
+      ++ formatted object t to strings.
+    setPrologue!: (%, L S) -> L S
+      ++ setPrologue!(t,strings) sets the prologue section of a
+      ++ formatted object t to strings.
+
+  private == add
+    import OutputForm
+    import Character
+    import Integer
+    import List OutputForm
+    import List String
+
+    Rep := Record(prolog : L S, formula : L S, epilog : L S)
+
+    -- local variables declarations and definitions
+
+    expr: E
+    prec,opPrec: I
+    str:  S
+    blank         : S := " @@ "
+
+    maxPrec       : I   := 1000000
+    minPrec       : I   := 0
+
+    splitChars    : S   := " <>[](){}+*=,-%"
+
+    unaryOps      : L S := ["-","^"]$(L S)
+    unaryPrecs    : L I := [700,260]$(L I)
+
+    -- the precedence of / in the following is relatively low because
+    -- the bar obviates the need for parentheses.
+    binaryOps     : L S := ["+->","|","**","/","<",">","=","OVER"]$(L S)
+    binaryPrecs   : L I := [0,0,900, 700,400,400,400,   700]$(L I)
+
+    naryOps       : L S := ["-","+","*",blank,",",";"," ","ROW","",
+                            " habove "," here "," labove "]$(L S)
+    naryPrecs     : L I := [700,700,800,  800,110,110,  0,    0, 0,
+                            0,  0,  0]$(L I)
+--  naryNGOps     : L S := ["ROW"," here "]$(L S)
+    naryNGOps     : L S := nil$(L S)
+
+    plexOps       : L S := ["SIGMA","PI","INTSIGN","INDEFINTEGRAL"]$(L S)
+    plexPrecs     : L I := [    700, 800,      700,            700]$(L I)
+
+    specialOps    : L S := ["MATRIX","BRACKET","BRACE","CONCATB",     _
+                            "AGGLST","CONCAT","OVERBAR","ROOT","SUB", _
+                            "SUPERSUB","ZAG","AGGSET","SC","PAREN"]
+
+    -- the next two lists provide translations for some strings for
+    -- which the formula formatter provides special variables.
+
+    specialStrings : L S :=
+      ["5","..."]
+    specialStringsInFormula : L S :=
+      [" alpha "," ellipsis "]
+
+    -- local function signatures
+
+    addBraces:      S -> S
+    addBrackets:    S -> S
+    group:          S -> S
+    formatBinary:   (S,L E, I) -> S
+    formatFunction: (S,L E, I) -> S
+    formatMatrix:   L E -> S
+    formatNary:     (S,L E, I) -> S
+    formatNaryNoGroup: (S,L E, I) -> S
+    formatNullary:  S -> S
+    formatPlex:     (S,L E, I) -> S
+    formatSpecial:  (S,L E, I) -> S
+    formatUnary:    (S,  E, I) -> S
+    formatFormula:      (E,I) -> S
+    parenthesize:   S -> S
+    precondition:   E -> E
+    postcondition:  S -> S
+    splitLong:      (S,I) -> L S
+    splitLong1:     (S,I) -> L S
+    stringify:      E -> S
+
+    -- public function definitions
+
+    new() : % == [[".eq set blank @",":df."]$(L S),
+      [""]$(L S), [":edf."]$(L S)]$Rep
+
+    coerce(expr : E): % ==
+      f : % := new()$%
+      f.formula := [postcondition
+        formatFormula(precondition expr, minPrec)]$(L S)
+      f
+
+    convert(expr : E, stepNum : I): % ==
+      f : % := new()$%
+      f.formula := concat(["<leqno lparen ",string(stepNum)$S,
+        " rparen>"], [postcondition
+          formatFormula(precondition expr, minPrec)]$(L S))
+      f
+
+    display(f : %, len : I) ==
+      s,t : S
+      for s in f.prolog repeat sayFORMULA(s)$Lisp
+      for s in f.formula repeat
+        for t in splitLong(s, len) repeat sayFORMULA(t)$Lisp
+      for s in f.epilog repeat sayFORMULA(s)$Lisp
+      void()$Void
+
+    display(f : %) ==
+      display(f, _$LINELENGTH$Lisp pretend I)
+
+    prologue(f : %) == f.prolog
+    formula(f : %)  == f.formula
+    epilogue(f : %) == f.epilog
+
+    setPrologue!(f : %, l : L S) == f.prolog := l
+    setFormula!(f : %, l : L S)  == f.formula := l
+    setEpilogue!(f : %, l : L S) == f.epilog := l
+
+    coerce(f : %): E ==
+      s,t : S
+      l : L S := nil
+      for s in f.prolog repeat l := concat(s,l)
+      for s in f.formula repeat
+        for t in splitLong(s, (_$LINELENGTH$Lisp pretend Integer) - 4) repeat
+          l := concat(t,l)
+      for s in f.epilog repeat l := concat(s,l)
+      (reverse l) :: E
+
+    -- local function definitions
+
+    postcondition(str: S): S ==
+      len : I := #str
+      len < 4 => str
+      plus : Character := char "+"
+      minus: Character := char "-"
+      for i in 1..(len-1) repeat
+        if (str.i =$Character plus) and (str.(i+1) =$Character minus)
+          then setelt(str,i,char " ")$S
+      str
+
+    stringify expr == object2String(expr)$Lisp pretend S
+
+    splitLong(str : S, len : I): L S ==
+      -- this blocks into lines
+      if len < 20 then len := _$LINELENGTH$Lisp
+      splitLong1(str, len)
+
+    splitLong1(str : S, len : I) ==
+      l : List S := nil
+      s : S := ""
+      ls : I := 0
+      ss : S
+      lss : I
+      for ss in split(str,char " ") repeat
+        lss := #ss
+        if ls + lss > len then
+          l := concat(s,l)$List(S)
+          s := ""
+          ls := 0
+        lss > len => l := concat(ss,l)$List(S)
+        ls := ls + lss + 1
+        s := concat(s,concat(ss," ")$S)$S
+      if ls > 0 then l := concat(s,l)$List(S)
+      reverse l
+
+    group str ==
+      concat ["<",str,">"]
+
+    addBraces str ==
+      concat ["left lbrace ",str," right rbrace"]
+
+    addBrackets str ==
+      concat ["left lb ",str," right rb"]
+
+    parenthesize str ==
+      concat ["left lparen ",str," right rparen"]
+
+    precondition expr ==
+      outputTran(expr)$Lisp
+
+    formatSpecial(op : S, args : L E, prec : I) : S ==
+      op = "AGGLST" =>
+        formatNary(",",args,prec)
+      op = "AGGSET" =>
+        formatNary(";",args,prec)
+      op = "CONCATB" =>
+        formatNary(" ",args,prec)
+      op = "CONCAT" =>
+        formatNary("",args,prec)
+      op = "BRACKET" =>
+        group addBrackets formatFormula(first args, minPrec)
+      op = "BRACE" =>
+        group addBraces formatFormula(first args, minPrec)
+      op = "PAREN" =>
+        group parenthesize formatFormula(first args, minPrec)
+      op = "OVERBAR" =>
+        null args => ""
+        group concat [formatFormula(first args, minPrec)," bar"]
+      op = "ROOT" =>
+        null args => ""
+        tmp : S := formatFormula(first args, minPrec)
+        null rest args => group concat ["sqrt ",tmp]
+        group concat ["midsup adjust(u 1.5 r 9) ",
+          formatFormula(first rest args, minPrec)," sqrt ",tmp]
+      op = "SC" =>
+        formatNary(" labove ",args,prec)
+      op = "SUB" =>
+        group concat [formatFormula(first args, minPrec)," sub ",
+          formatSpecial("AGGLST",rest args,minPrec)]
+      op = "SUPERSUB" =>
+        -- variable name
+        form : List S := [formatFormula(first args, minPrec)]
+        -- subscripts
+        args := rest args
+        null args => concat form
+        tmp : S := formatFormula(first args, minPrec)
+        if tmp ^= "" then form := append(form,[" sub ",tmp])$(List S)
+        -- superscripts
+        args := rest args
+        null args => group concat form
+        tmp : S := formatFormula(first args, minPrec)
+        if tmp ^= "" then form := append(form,[" sup ",tmp])$(List S)
+        -- presuperscripts
+        args := rest args
+        null args => group concat form
+        tmp : S := formatFormula(first args, minPrec)
+        if tmp ^= "" then form := append(form,[" presup ",tmp])$(List S)
+        -- presubscripts
+        args := rest args
+        null args => group concat form
+        tmp : S := formatFormula(first args, minPrec)
+        if tmp ^= "" then form := append(form,[" presub ",tmp])$(List S)
+        group concat form
+      op = "MATRIX" => formatMatrix rest args
+--    op = "ZAG" =>
+--      concat ["\zag{",formatFormula(first args, minPrec),"}{",
+--        formatFormula(first rest args,minPrec),"}"]
+      concat ["not done yet for ",op]
+
+    formatPlex(op : S, args : L E, prec : I) : S ==
+      hold : S
+      p : I := position(op,plexOps)
+      p < 1 => error "unknown Script Formula Formatter unary op"
+      opPrec := plexPrecs.p
+      n : I := #args
+      (n ^= 2) and (n ^= 3) => error "wrong number of arguments for plex"
+      s : S :=
+        op = "SIGMA"   => "sum"
+        op = "PI"      => "product"
+        op = "INTSIGN" => "integral"
+        op = "INDEFINTEGRAL" => "integral"
+        "????"
+      hold := formatFormula(first args,minPrec)
+      args := rest args
+      if op ^= "INDEFINTEGRAL" then
+        if hold ^= "" then
+          s := concat [s," from",group concat ["\displaystyle ",hold]]
+        if not null rest args then
+          hold := formatFormula(first args,minPrec)
+          if hold ^= "" then
+            s := concat [s," to",group concat ["\displaystyle ",hold]]
+          args := rest args
+        s := concat [s," ",formatFormula(first args,minPrec)]
+      else
+        hold := group concat [hold," ",formatFormula(first args,minPrec)]
+        s := concat [s," ",hold]
+      if opPrec < prec then s := parenthesize s
+      group s
+
+    formatMatrix(args : L E) : S ==
+      -- format for args is [[ROW ...],[ROW ...],[ROW ...]]
+      group addBrackets formatNary(" habove ",args,minPrec)
+
+    formatFunction(op : S, args : L E, prec : I) : S ==
+      group concat [op, " ", parenthesize formatNary(",",args,minPrec)]
+
+    formatNullary(op : S) ==
+      op = "NOTHING" => ""
+      group concat [op,"()"]
+
+    formatUnary(op : S, arg : E, prec : I) ==
+      p : I := position(op,unaryOps)
+      p < 1 => error "unknown Script Formula Formatter unary op"
+      opPrec := unaryPrecs.p
+      s : S := concat [op,formatFormula(arg,opPrec)]
+      opPrec < prec => group parenthesize s
+      op = "-" => s
+      group s
+
+    formatBinary(op : S, args : L E, prec : I) : S ==
+      p : I := position(op,binaryOps)
+      p < 1 => error "unknown Script Formula Formatter binary op"
+      op :=
+        op = "**"    => " sup "
+        op = "/"     => " over "
+        op = "OVER"  => " over "
+        op
+      opPrec := binaryPrecs.p
+      s : S := formatFormula(first args, opPrec)
+      s := concat [s,op,formatFormula(first rest args, opPrec)]
+      group
+        op = " over " => s
+        opPrec < prec => parenthesize s
+        s
+
+    formatNary(op : S, args : L E, prec : I) : S ==
+      group formatNaryNoGroup(op, args, prec)
+
+    formatNaryNoGroup(op : S, args : L E, prec : I) : S ==
+      null args => ""
+      p : I := position(op,naryOps)
+      p < 1 => error "unknown Script Formula Formatter nary op"
+      op :=
+        op = ","     => ", @@ "
+        op = ";"     => "; @@ "
+        op = "*"     => blank
+        op = " "     => blank
+        op = "ROW"   => " here "
+        op
+      l : L S := nil
+      opPrec := naryPrecs.p
+      for a in args repeat
+        l := concat(op,concat(formatFormula(a,opPrec),l)$L(S))$L(S)
+      s : S := concat reverse rest l
+      opPrec < prec => parenthesize s
+      s
+
+    formatFormula(expr,prec) ==
+      i : Integer
+      ATOM(expr)$Lisp pretend Boolean =>
+        str := stringify expr
+        FIXP(expr)$Lisp =>
+          i := expr : Integer
+          if (i < 0) or (i > 9) then group str else str
+        (i := position(str,specialStrings)) > 0 =>
+          specialStringsInFormula.i
+        str
+      l : L E := (expr pretend L E)
+      null l => blank
+      op : S := stringify first l
+      args : L E := rest l
+      nargs : I := #args
+
+      -- special cases
+      member?(op, specialOps) => formatSpecial(op,args,prec)
+      member?(op, plexOps)    => formatPlex(op,args,prec)
+
+      -- nullary case
+      0 = nargs => formatNullary op
+
+      -- unary case
+      (1 = nargs) and member?(op, unaryOps) =>
+        formatUnary(op, first args, prec)
+
+      -- binary case
+      (2 = nargs) and member?(op, binaryOps) =>
+        formatBinary(op, args, prec)
+
+      -- nary case
+      member?(op,naryNGOps) => formatNaryNoGroup(op,args, prec)
+      member?(op,naryOps) => formatNary(op,args, prec)
+      op := formatFormula(first l,minPrec)
+      formatFunction(op,args,prec)
+
+@
+\section{package FORMULA1 ScriptFormulaFormat1}
+<<package FORMULA1 ScriptFormulaFormat1>>=
+)abbrev package FORMULA1 ScriptFormulaFormat1
+++ Author: Robert S. Sutor
+++ Date Created: 1987 through 1990
+++ Change History:
+++ Basic Operations: coerce
+++ Related Constructors: ScriptFormulaFormat
+++ Also See: TexFormat, TexFormat1
+++ AMS Classifications:
+++ Keywords: output, format, SCRIPT, BookMaster, formula
+++ References:
+++   SCRIPT Mathematical Formula Formatter User's Guide, SH20-6453,
+++   IBM Corporation, Publishing Systems Information Development,
+++   Dept. G68, P.O. Box 1900, Boulder, Colorado, USA 80301-9191.
+++ Description:
+++   \spadtype{ScriptFormulaFormat1} provides a utility coercion for
+++   changing to SCRIPT formula format anything that has a coercion to
+++   the standard output format.
+
+ScriptFormulaFormat1(S : SetCategory): public == private where
+  public  ==  with
+    coerce: S -> ScriptFormulaFormat()
+      ++ coerce(s) provides a direct coercion from an expression s of domain S to
+      ++ SCRIPT formula format. This allows the user to skip the step of
+      ++ first manually coercing the object to standard output format
+      ++ before it is coerced to SCRIPT formula format.
+
+  private == add
+    import ScriptFormulaFormat()
+
+    coerce(s : S): ScriptFormulaFormat ==
+      coerce(s :: OutputForm)$ScriptFormulaFormat
+
+@
+\section{License}
+<<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.
+@
+<<*>>=
+<<license>>
+
+<<domain FORMULA ScriptFormulaFormat>>
+<<package FORMULA1 ScriptFormulaFormat1>>
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
-- 
cgit v1.2.3