)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) ==
        (n = 1) => x
        odd?(n)$Integer=> x*expt(x*x, qcoerce(shift(n, -1))@PositiveInteger)
        expt(x*x, qcoerce(shift(n, -1))@PositiveInteger)

)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) ==
        (n = 1) => x
        odd?(n)$Integer =>
           x + double(qcoerce(shift(n, -1))@PositiveInteger, x + x)
        double(qcoerce(shift(n, -1))@PositiveInteger, x + x)

)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 : Join(FiniteLinearAggregate(S), 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 break

    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)
        while i <= j repeat
            t := qelt(r, i)
            while l(t, x) repeat
                i := i + 1
                t := qelt(r, i)
            s := qelt(r, j)
            while l(x, s) repeat
                j := j - 1
                s := qelt(r, j)
            if i <= j then
                qsetelt!(r, i, s)
                qsetelt!(r, j, t)
                i := i + 1
                j := j - 1
        j + 1

    QuickSort(l, r, i, j) ==
        repeat
            n := j - i
            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))
            if k - i < j - k then
                QuickSort(l, r, i, k - 1)
                i := k
            else
                QuickSort(l, r, k, j)
                j := k - 1

    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

--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.
