Initial population.

1 files changed, 221 insertions, 0 deletions

diff --git a/src/algebra/defaults.spad.pamphlet b/src/algebra/defaults.spad.pamphlet
new file mode 100644
index 00000000..f4c99786
--- /dev/null
+++ b/src/algebra/defaults.spad.pamphlet
@@ -0,0 +1,221 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/algebra defaults.spad}
+\author{Michael Monagan}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{package REPSQ RepeatedSquaring}
+<<package REPSQ RepeatedSquaring>>=
+)abbrev package REPSQ RepeatedSquaring
+++ Repeated Squaring
+++ Description:
+++ Implements exponentiation by repeated squaring
+++ RelatedOperations: expt
+-- the following package is only instantiated over %
+-- thus shouldn't be cached. We prevent it
+-- from being cached by declaring it to be mutableDomains
+
+)bo PUSH('RepeatedSquaring, $mutableDomains) 
+
+RepeatedSquaring(S): Exports == Implementation where
+   S: SetCategory with 
+	"*":(%,%)->%
+	     ++ x*y returns the product of x and y
+   Exports == with
+     expt: (S,PositiveInteger) -> S 
+       ++ expt(r, i) computes r**i  by repeated squaring
+   Implementation == add
+     x: S
+     n: PositiveInteger
+     expt(x, n) ==
+--        one? n => x
+        (n = 1) => x
+        odd?(n)$Integer=> x * expt(x*x,shift(n,-1) pretend PositiveInteger)
+        expt(x*x,shift(n,-1) pretend PositiveInteger)
+
+@
+\section{package REPDB RepeatedDoubling}
+<<package REPDB RepeatedDoubling>>=
+)abbrev package REPDB RepeatedDoubling
+++ Repeated Doubling
+++ Integer multiplication by repeated doubling.
+++ Description:
+++ Implements multiplication by repeated addition
+++ RelatedOperations: *
+ 
+-- the following package is only instantiated over %
+-- thus shouldn't be cached. We prevent it
+-- from being cached by declaring it to be mutableDomains
+
+)bo PUSH('RepeatedDoubling, $mutableDomains) 
+
+RepeatedDoubling(S):Exports ==Implementation where
+   S: SetCategory with 
+	"+":(%,%)->%
+		++ x+y returns the sum of x and y
+   Exports == with
+     double: (PositiveInteger,S) -> S 
+       ++ double(i, r) multiplies r by i using repeated doubling.
+   Implementation == add
+     x: S
+     n: PositiveInteger
+     double(n,x) ==
+--        one? n => x
+        (n = 1) => x
+        odd?(n)$Integer =>
+           x + double(shift(n,-1) pretend PositiveInteger,(x+x))
+        double(shift(n,-1) pretend PositiveInteger,(x+x))
+
+@
+\section{package FLASORT FiniteLinearAggregateSort}
+<<package FLASORT FiniteLinearAggregateSort>>=
+)abbrev package FLASORT FiniteLinearAggregateSort
+++ FiniteLinearAggregateSort
+++ Sort package (in-place) for shallowlyMutable Finite Linear Aggregates
+++ Author: Michael Monagan Sep/88
+++ RelatedOperations: sort
+++ Description:
+++  This package exports 3 sorting algorithms which work over 
+++  FiniteLinearAggregates.
+-- the following package is only instantiated over %
+-- thus shouldn't be cached. We prevent it
+-- from being cached by declaring it to be mutableDomains
+ 
+)bo PUSH('FiniteLinearAggregateSort, $mutableDomains) 
+
+FiniteLinearAggregateSort(S, V): Exports == Implementation where
+  S: Type
+  V: FiniteLinearAggregate(S) with shallowlyMutable
+ 
+  B ==> Boolean
+  I ==> Integer
+ 
+  Exports ==> with
+    quickSort: ((S, S) -> B, V) -> V
+      ++ quickSort(f, agg) sorts the aggregate agg with the ordering function
+      ++ f using the quicksort algorithm.
+    heapSort : ((S, S) -> B, V) -> V
+      ++ heapSort(f, agg) sorts the aggregate agg with the ordering function
+      ++ f using the heapsort algorithm.
+    shellSort: ((S, S) -> B, V) -> V
+      ++ shellSort(f, agg) sorts the aggregate agg with the ordering function
+      ++ f using the shellSort algorithm.
+ 
+  Implementation ==> add
+    siftUp   : ((S, S) -> B, V, I, I) -> Void
+    partition: ((S, S) -> B, V, I, I, I) -> I
+    QuickSort: ((S, S) -> B, V, I, I) -> V
+ 
+    quickSort(l, r) == QuickSort(l, r, minIndex r, maxIndex r)
+ 
+    siftUp(l, r, i, n) ==
+      t := qelt(r, i)
+      while (j := 2*i+1) < n repeat
+        if (k := j+1) < n and l(qelt(r, j), qelt(r, k)) then j := k
+        if l(t,qelt(r,j)) then
+           qsetelt_!(r, i, qelt(r, j))
+           qsetelt_!(r, j, t)
+           i := j
+        else leave
+ 
+    heapSort(l, r) ==
+      not zero? minIndex r => error "not implemented"
+      n := (#r)::I
+      for k in shift(n,-1) - 1 .. 0 by -1 repeat siftUp(l, r, k, n)
+      for k in n-1 .. 1 by -1 repeat
+         swap_!(r, 0, k)
+         siftUp(l, r, 0, k)
+      r
+ 
+    partition(l, r, i, j, k) ==
+      -- partition r[i..j] such that r.s <= r.k <= r.t
+      x := qelt(r, k)
+      t := qelt(r, i)
+      qsetelt_!(r, k, qelt(r, j))
+      while i < j repeat
+         if l(x,t) then
+           qsetelt_!(r, j, t)
+           j := j-1
+           t := qsetelt_!(r, i, qelt(r, j))
+         else (i := i+1; t := qelt(r, i))
+      qsetelt_!(r, j, x)
+      j
+ 
+    QuickSort(l, r, i, j) ==
+      n := j - i
+--      if one? n and l(qelt(r, j), qelt(r, i)) then swap_!(r, i, j)
+      if (n = 1) and l(qelt(r, j), qelt(r, i)) then swap_!(r, i, j)
+      n < 2 => return r
+      -- for the moment split at the middle item
+      k := partition(l, r, i, j, i + shift(n,-1))
+      QuickSort(l, r, i, k - 1)
+      QuickSort(l, r, k + 1, j)
+ 
+    shellSort(l, r) ==
+      m := minIndex r
+      n := maxIndex r
+      -- use Knuths gap sequence: 1,4,13,40,121,...
+      g := 1
+      while g <= (n-m) repeat g := 3*g+1
+      g := g quo 3
+      while g > 0 repeat
+         for i in m+g..n repeat
+            j := i-g
+            while j >= m and l(qelt(r, j+g), qelt(r, j)) repeat
+               swap_!(r,j,j+g)
+               j := j-g
+         g := g quo 3
+      r
+
+@
+\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>>
+
+<<package REPSQ RepeatedSquaring>>
+<<package REPDB RepeatedDoubling>>
+<<package FLASORT FiniteLinearAggregateSort>>
+ 
+@ 
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}