seg.spad

)abbrev category SEGCAT SegmentCategory
++ Author:  Stephen M. Watt
++ Date Created:  December 1986
++ Basic Operations:
++ Related Domains:
++ Also See:
++ AMS Classifications:
++ Keywords: range, segment
++ Examples:
++ References:
++ Description:
++   This category provides operations on ranges, or {\em segments}
++   as they are called.

SegmentCategory(S : Type) : Category == Type with
    SEGMENT : (S, S) -> %
        ++ \spad{l..h} creates a segment with l and h as the endpoints.
    BY : (%, Integer) -> %
        ++ \spad{s by n} creates a new segment in which only every \spad{n}-th
        ++ element is used.
    low : % -> S
        ++ low(s) returns the first endpoint of s.
        ++ Note: \spad{low(l..h) = l}.
    high : % -> S
        ++ high(s) returns the second endpoint of s.
        ++ Note: \spad{high(l..h) = h}.
    incr : % -> Integer
        ++ incr(s) returns \spad{n}, where s is a segment in which every
        ++ \spad{n}-th element is used.
        ++ Note: \spad{incr(l..h by n) = n}.
    segment : (S, S) -> %
        ++ segment(i, j) is an alternate way to create the segment \spad{i..j}.
    convert : S -> %
        ++ convert(i) creates the segment \spad{i..i}.

    if S has SetCategory then SetCategory
    if S has ConvertibleTo InputForm then ConvertibleTo InputForm
    if S has AbelianSemiGroup then
        "+" : (S, %) -> %
            ++ \spad{i+(l..h)} returns segment \spad{i+l .. i+h}.
        "+" : (%, S) -> %
            ++ \spad{(l..h)+i} returns segment \spad{l+i .. h+i}.
    if S has AbelianGroup then
        "-" : (%, S) -> %
            ++ \spad{(l..h)-i} returns segment \spad{l-i .. h-i}.
    if S has OrderedRing then
        reverse : % -> %
            ++ reverse(s) returns segment s in reverse order.

)abbrev category SEGXCAT SegmentExpansionCategory
++ Author:  Stephen M. Watt
++ Date Created: June 5, 1991
++ Basic Operations:
++ Related Domains: Segment, UniversalSegment
++ Also See:
++ AMS Classifications:
++ Keywords:
++ Examples:
++ References:
++ Description:
++   This category provides an interface for expanding segments to
++   a stream of elements.
SegmentExpansionCategory(S : OrderedRing, L : StreamAggregate(S)) : Category ==
    SegmentCategory(S) with
      expand : List % -> L
        ++ expand(l) creates a new value of type L in which each segment
        ++ \spad{l..h by k} is replaced with \spad{l, l+k, ... lN},
        ++ where \spad{lN <= h < lN+k}.
        ++ For example, \spad{expand [1..4, 7..9] = [1, 2, 3, 4, 7, 8, 9]}.
      expand : % -> L
        ++ expand(l..h by k) creates value of type L with elements
        ++ \spad{l, l+k, ... lN} where \spad{lN <= h < lN+k}.
        ++ For example, \spad{expand(1..5 by 2) = [1, 3, 5]}.
      map : (S -> S, %) -> L
        ++ map(f, l..h by k) produces a value of type L by applying f
        ++ to each of the successive elements of the segment, that is,
        ++ \spad{[f(l), f(l+k), ..., f(lN)]}, where \spad{lN <= h < lN+k}.

)abbrev domain SEG Segment
++ Author:  Stephen M. Watt
++ Date Created:  December 1986
++ Basic Operations:
++ Related Domains:
++ Also See:
++ AMS Classifications:
++ Keywords: range, segment
++ Examples:
++ References:
++ Description:
++   This type is used to specify a range of values from type \spad{S}.

Segment(S : Type) : SegmentCategory(S) with
    if S has OrderedRing then SegmentExpansionCategory(S, List S)
  == add

    Rep := Record(low : S, high : S, incr : Integer)

    a..b == [a, b, 1]
    low s == s.low
    high s == s.high
    incr s == s.incr
    segment(a, b) == [a, b, 1]
    BY(s, r) == [low(s), high(s), r]

    if S has SetCategory then
      (s1 : %) = (s2 : %) ==
        s1.low = s2.low and s1.high = s2.high and s1.incr = s2.incr

      coerce(s : %) : OutputForm ==
        seg := SEGMENT(s.low::OutputForm, s.high::OutputForm)
        s.incr = 1 => seg
        infix(message(" by "), seg, s.incr::OutputForm)

    convert(a : S) : % == [a, a, 1]

    if S has ConvertibleTo InputForm then
        INFORM1 ==> InputFormFunctions1(%)

        convert(s : %) : InputForm ==

            seg := packageCall('SEGMENT,
                               [convert(low(s))@InputForm,
                                convert(high(s))@InputForm])$INFORM1
            if one?(incr s)
            then seg
            else packageCall('BY,
                             [seg, convert(incr s)@InputForm])$INFORM1

    if S has AbelianSemiGroup then
        (i : S + s : %) ==
            [i + low(s), i + high(s), incr(s)]
        (s : % + i : S) ==
            [low(s) + i, high(s) + i, incr(s)]

    if S has AbelianGroup then
        (s : % - i : S) ==
            [low(s) - i, high(s) - i, incr(s)]

    if S has OrderedRing then

      reverse(s : %) : % == [high(s), low(s), -incr(s)]

      expand(ls : List %) : List S ==
        lr := []$List(S)
        for s in ls repeat
          l := low(s)
          h := high(s)
          inc := (incr s)::S
          zero? inc => error "Cannot expand a segment with an increment of zero"
          if inc > 0 then
            while l <= h repeat
              lr := concat(l, lr)
              l := l + inc
          else
            while l >= h repeat
              lr := concat(l, lr)
              l := l + inc
        reverse! lr

      expand(s : %) == expand([s]$List(%))$%
      map(f : S->S, s : %) : List S ==
        lr := []$List(S)
        l := low(s)
        h := high(s)
        inc := (incr s)::S
        if inc > 0 then
          while l <= h repeat
            lr := concat(f l, lr)
            l := l + inc
        else
          while l >= h repeat
            lr := concat(f l, lr)
            l := l + inc
        reverse! lr

)abbrev package SEG2 SegmentFunctions2
++ Author:
++ Basic Operations:
++ Related Domains: Segment, UniversalSegment
++ Also See:
++ AMS Classifications:
++ Keywords: equation
++ Examples:
++ References:
++ Description:
++   This package provides operations for mapping functions onto segments.

SegmentFunctions2(R : Type, S : Type) : public == private where
  public ==> with
    map : (R -> S, Segment R) -> Segment S
        ++ map(f, l..h) returns a new segment \spad{f(l)..f(h)}.

    if R has OrderedRing then
      map : (R -> S, Segment R) -> List S
        ++ map(f, s) expands the segment s, applying \spad{f} to each
        ++ value.  For example, if \spad{s = l..h by k}, then the list
        ++ \spad{[f(l), f(l+k), ..., f(lN)]} is computed, where
        ++ \spad{lN <= h < lN+k}.


  private ==> add
    map(f : R->S, r : Segment R) : Segment S ==
      SEGMENT(f(low(r)), f(high(r)))$Segment(S)

    if R has OrderedRing then
     map(f : R->S, r : Segment R) : List S ==
       lr := []$List(S)
       l := low(r)
       h := high(r)
       inc := (incr r)::R
       if inc > 0 then
         while l <= h repeat
           lr := concat(f(l), lr)
           l := l + inc
       else
         while l >= h repeat
           lr := concat(f(l), lr)
           l := l + inc
       reverse! lr

)abbrev domain SEGBIND SegmentBinding
++ Author:
++ Basic Operations:
++ Related Domains: Equation, Segment, Symbol
++ Also See:
++ AMS Classifications:
++ Keywords: equation
++ Examples:
++ References:
++ Description:
++   This domain is used to provide the function argument syntax \spad{v=a..b}.
++   This is used, for example, by the top-level \spadfun{draw} functions.
SegmentBinding(S : Type) : Type with
  equation : (Symbol, Segment S) -> %
      ++ equation(v, a..b) creates a segment binding value with variable
      ++ \spad{v} and segment \spad{a..b}.  Note that the interpreter parses
      ++ \spad{v=a..b} to this form.
  variable : % -> Symbol
      ++ variable(segb) returns the variable from the left hand side of
      ++ the \spadtype{SegmentBinding}.  For example, if \spad{segb} is
      ++ \spad{v=a..b}, then \spad{variable(segb)} returns \spad{v}.
  segment : % -> Segment S
      ++ segment(segb) returns the segment from the right hand side of
      ++ the \spadtype{SegmentBinding}.  For example, if \spad{segb} is
      ++ \spad{v=a..b}, then \spad{segment(segb)} returns \spad{a..b}.

  if S has SetCategory then SetCategory
  if S has ConvertibleTo InputForm then ConvertibleTo InputForm
 == add
  Rep := Record(var : Symbol, seg : Segment S)
  equation(x, s) == [x, s]
  variable b    == b.var
  segment b     == b.seg

  if S has SetCategory then

     b1 = b2       == variable b1 = variable b2 and segment b1 = segment b2

     coerce(b : %) : OutputForm ==
       variable(b)::OutputForm = segment(b)::OutputForm

  if S has ConvertibleTo InputForm then
     INFORM1 ==> InputFormFunctions1(%)
     convert b ==
       packageCall('equation,
                   [convert(variable(b))@InputForm,
                    convert(segment(b))@InputForm])$INFORM1

)abbrev package SEGBIND2 SegmentBindingFunctions2
++ Author:
++ Basic Operations:
++ Related Domains: SegmentBinding, Segment, Equation
++ Also See:
++ AMS Classifications:
++ Keywords: equation
++ Examples:
++ References:
++ Description:
++   This package provides operations for mapping functions onto
++   \spadtype{SegmentBinding}s.
SegmentBindingFunctions2(R : Type, S : Type) : with
  map : (R -> S, SegmentBinding R) -> SegmentBinding S
      ++ map(f, v=a..b) returns the value given by \spad{v=f(a)..f(b)}.
 == add
  map(f, b) ==
    equation(variable b, map(f, segment b)$SegmentFunctions2(R, S))

)abbrev domain UNISEG UniversalSegment
++ Author:  Robert S. Sutor
++ Date Created: 1987
++ Basic Operations:
++ Related Domains: Segment
++ Also See:
++ AMS Classifications:
++ Keywords: equation
++ Examples:
++ References:
++ Description:
++  This domain provides segments which may be half open.
++  That is, ranges of the form \spad{a..} or \spad{a..b}.

UniversalSegment(S : Type) : SegmentCategory(S) with
    SEGMENT : S -> %
        ++ \spad{l..} produces a half open segment,
        ++ that is, one with no upper bound.
    segment : S -> %
        ++ segment(l) is an alternate way to construct the segment \spad{l..}.
    coerce : Segment S -> %
        ++ coerce(x) allows \spadtype{Segment} values to be used as %.
    hasHi : % -> Boolean
        ++ hasHi(s) tests whether the segment s has an upper bound.

    if S has OrderedRing then
      SegmentExpansionCategory(S, Stream S)

  == add
    Rec  ==> Segment S
    Rec2 ==> Record(low : S, incr : Integer)

    Rep := Union(Rec2, Rec)
    a, b : S
    s : %
    i : Integer
    ls : List %

    segment a == [a, 1]$Rec2 :: Rep
    segment(a, b) == segment(a, b)$Rec :: Rep
    BY(s, i) ==
      s case Rec => BY(s, i)$Rec :: Rep
      [low(s), i]$Rec2 :: Rep

    low s ==
      s case Rec2 => (s@Rec2).low
      low(s)$Rec

    hasHi s == s case Rec

    high s ==
      not hasHi(s) => error "high: segment has no upper bound"
      high(s)$Rec

    incr s ==
      s case Rec2 => (s@Rec2).incr
      incr(s)$Rec

    SEGMENT(a) == segment a
    SEGMENT(a, b) == segment(a, b)

    coerce(sg : Segment S) : % == sg

    convert a == convert(a)$Rec

    if S has SetCategory then

       (s1 : %) = (s2 : %) ==
          s1 case Rec2 =>
             s2 case Rec2 =>
                 s1.low = s2.low and s1.incr = s2.incr
             false
          s1 case Rec =>
             s2 case Rec =>
                 s1 =$Rec s2
             false
          false

       coerce(s : %) : OutputForm ==
         seg :=
           e := (low(s))::OutputForm
           hasHi s => SEGMENT(e, (high(s))::OutputForm)
           SEGMENT e
         inc := incr s
         inc = 1 => seg
         infix(message(" by "), seg, inc::OutputForm)

    if S has ConvertibleTo InputForm then
        INFORM1 ==> InputFormFunctions1(%)

        convert(s : %) : InputForm ==
            s case Rec => convert(s)$Rec
            seg := packageCall('SEGMENT,
                               [convert(low s)@InputForm])$INFORM1
            if one?(incr s)
            then seg
            else packageCall('BY,
                             [seg, convert(incr s)@InputForm])$INFORM1

    if S has AbelianSemiGroup then
        (i : S + s : %) ==
            s case Rec => (i+s)$Rec
            [i + low(s), incr(s)]
        (s : % + i : S) ==
            s case Rec => (s+i)$Rec
            [low(s) + i, incr(s)]

    if S has AbelianGroup then
        (s : % - i : S) ==
            s case Rec => (s-i)$Rec
            [low(s) - i, incr(s)]

    if S has OrderedRing then
      expand(s : %)       == expand([s])
      map(f : S->S, s : %)  == map(f, expand s)

      expand(ls : List %) : Stream S ==
        st : Stream S := empty()
        empty?(ls) => st

        lb : List(Segment S) := []
        while not(empty?(ls)) and hasHi first ls repeat
            s  := first ls
            ls := rest ls
            ns := BY(SEGMENT(low(s), high(s)), incr s)$Segment(S)
            lb := concat!(lb, ns)
        if not(empty?(ls)) then
            s := first ls
            st : Stream S := stream(x +-> x + incr(s)::S, low(s))
        else
            st : Stream S := empty()
        concat(construct expand(lb),  st)

)abbrev package UNISEG2 UniversalSegmentFunctions2
++ Author:
++ Basic Operations:
++ Related Domains: Segment, UniversalSegment
++ Also See:
++ AMS Classifications:
++ Keywords: equation
++ Examples:
++ References:
++ Description:
++   This package provides operations for mapping functions onto segments.

UniversalSegmentFunctions2(R : Type, S : Type) : with
    map : (R -> S, UniversalSegment R) -> UniversalSegment S
        ++ map(f, seg) returns the new segment obtained by applying
        ++ f to the endpoints of seg.

    if R has OrderedRing then
      map : (R -> S, UniversalSegment R) -> Stream S
        ++ map(f, s) expands the segment s, applying \spad{f} to each value.


  == add
    map(f : R -> S, u : UniversalSegment R) : UniversalSegment S ==
      s := f(low(u))
      hasHi u => segment(s, f(high(u)))
      segment s

    if R has OrderedRing then
      map(f : R -> S, u : UniversalSegment R) : Stream S ==
        map(f, expand u)$StreamFunctions2(R, S)

)abbrev package INCRMAPS IncrementingMaps
++ Author:
++ Basic Operations:
++ Related Domains: UniversalSegment
++ Also See:
++ AMS Classifications:
++ Keywords: equation
++ Examples:
++ References:
++ Description:
++   This package provides operations to create incrementing functions.

IncrementingMaps(R : Join(Monoid, AbelianSemiGroup)) : with
    increment : () -> (R -> R)
        ++ increment() produces a function which adds \spad{1} to whatever
        ++ argument it is given.  For example, if {f := increment()} then
        ++ \spad{f x} is \spad{x+1}.
    incrementBy : R -> (R -> R)
        ++ incrementBy(n) produces a function which adds \spad{n} to whatever
        ++ argument it is given.  For example, if {f := increment(n)} then
        ++ \spad{f x} is \spad{x+n}.
  == add
    increment() == x +-> 1 + x
    incrementBy n == x +-> n + x

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