)if false
VectorCategory, DirectProductCategory, Vector, IndexedVector, DirectProduct

\spadtype{VectorCategory} represents the type of vector like objects,
i.e. finite sequences indexed by some finite segment of the
integers. The operations available on vectors depend on the structure
of the underlying components. Many operations from the component domain
are defined for vectors componentwise. It can by assumed that extraction or
updating components can be done in constant time.

\spadtype{IndexedVector} represents vector like objects with varying lengths
and a user-specified initial index.

\spadtype{Vector} represents vector like objects with varying lengths
and indexed by a finite segment of integers starting at 1.

\spadtype{DirectProductCategory} represents a finite cartesian product of
a given type. Many categorical properties are preserved under this construction.

\spadtype{DirectProduct} represents the finite direct or cartesian product
of an underlying component type. This contrasts with simple vectors in that
the members can be viewed as having constant length. Thus many
categorical properties can by lifted from the underlying component type.
Component extraction operations are provided but no updating operations.
Thus new direct product elements can either be created by converting
vector elements using the \spadfun{directProduct} function
or by taking appropriate linear combinations of basis vectors provided
by the \spad{unitVector} operation.

If the underlying component type is Finite then the DirectProduct
itself is Finite and may be enumerated via size() and index(). In this
enumeration the index of the leftmost (nth)component varies most quickly.
)endif

)abbrev category VECTCAT VectorCategory
++ Author:
++ Basic Functions:
++ Related Constructors: DirectProductCategory, Vector, IndexedVector
++ Also See:
++ AMS Classifications:
++ Keywords:
++ References:
++ Description:
++ \spadtype{VectorCategory} represents the type of vector like objects,
++ i.e. finite sequences indexed by some finite segment of the
++ integers. The operations available on vectors depend on the structure
++ of the underlying components. Many operations from the component domain
++ are defined for vectors componentwise. It can by assumed that extraction or
++ updating components can be done in constant time.

VectorCategory(R : Type) : Category == OneDimensionalArrayAggregate R with
    if R has AbelianSemiGroup then
      _+ : (%, %) -> %
        ++ x + y returns the component-wise sum of the vectors x and y.
        ++ Error: if x and y are not of the same length.
    if R has AbelianMonoid then
      zero : NonNegativeInteger -> %
        ++ zero(n) creates a zero vector of length n.
      zero? : % -> Boolean
        ++ zero?(x) returns true if x is a zero vector, false otherwise.
    if R has AbelianGroup then
      _- : % -> %
        ++ -x negates all components of the vector x.
      _- : (%, %) -> %
        ++ x - y returns the component-wise difference of the vectors x and y.
        ++ Error: if x and y are not of the same length.
      _* : (Integer, %) -> %
        ++ n * y multiplies each component of the vector y by the integer n.
    if R has SemiGroup then
      _* : (R, %) -> %
        ++ r * y multiplies the element r times each component of the vector y.
      _* : (%, R) -> %
        ++ y * r multiplies each component of the vector y by the element r.
    if R has AbelianMonoid and R has SemiRng then
      dot : (%, %) -> R
        ++ dot(x, y) computes the inner product of the two vectors x and y.
        ++ Error: if x and y are not of the same length.
    if R has Ring then
      outerProduct : (%, %) -> Matrix R
        ++ outerProduct(u, v) constructs the matrix whose (i, j)'th element is
        ++ u(i)*v(j).
      cross : (%, %) -> %
        ++ cross(u, v) constructs the cross product of u and v.
        ++ Error: if u and v are not of length 3.
    if R has RadicalCategory and R has Ring then
      length : % -> R
        ++ length(v) computes the sqrt(dot(v, v)), i.e. the euclidean
        ++ length
 add

    import from Integer

    if R has AbelianSemiGroup then
      u + v ==
        #u ~= #v => error "Vectors must be of the same length"
        map(_+ , u, v)

    if R has AbelianMonoid then

      zero n == new(n, 0)

      zero? y ==
          for i in minIndex(y)..maxIndex(y) repeat
              if qelt(y, i) ~= 0 then return false
          true

    if R has AbelianGroup then
      - u                 == map(x +-> - x, u)
      n : Integer * u : % == map(x +-> n*x, u)
      u - v           == u + (-v)

    if R has SemiGroup then

      u : % * r : R       == map(x +-> x*r, u)
      r : R * u : %       == map(x +-> r*x, u)

    if R has AbelianMonoid and R has SemiRng then

      dot(u, v) ==
        #u ~= #v => error "Vectors must be of the same length"
        _+/[qelt(u, i) * qelt(v, i) for i in minIndex u .. maxIndex u]

    if R has Ring then
      outerProduct(u, v) ==
        matrix [[qelt(u, i) * qelt(v, j) for i in minIndex u .. maxIndex u] _
                for j in minIndex v .. maxIndex v]
      cross(u, v) ==
        #u ~= 3 or #v ~= 3 => error "Vectors must be of length 3"
        construct [qelt(u, 2)*qelt(v, 3) - qelt(u, 3)*qelt(v, 2) , _
                   qelt(u, 3)*qelt(v, 1) - qelt(u, 1)*qelt(v, 3) , _
                   qelt(u, 1)*qelt(v, 2) - qelt(u, 2)*qelt(v, 1) ]

    if R has RadicalCategory and R has Ring then
      length p ==
         sqrt(dot(p, p))


)abbrev domain IVECTOR IndexedVector
++ Author:
++ Basic Functions:
++ Related Constructors: Vector, DirectProduct
++ Also See:
++ AMS Classifications:
++ Keywords:
++ References:
++ Description:
++   This type represents vector like objects with varying lengths
++ and a user-specified initial index.

IndexedVector(R : Type, mn : Integer):
  VectorCategory R == IndexedOneDimensionalArray(R, mn)


)abbrev domain VECTOR Vector
++ Author:
++ Basic Functions:
++ Related Constructors: IndexedVector, DirectProduct
++ Also See:
++ AMS Classifications:
++ Keywords:
++ References:
++ Description:
++ This type represents vector like objects with varying lengths
++ and indexed by a finite segment of integers starting at 1.

Vector(R : Type) : Exports == Implementation where
 VECTORMININDEX ==> 1       -- if you want to change this, be my guest

 Exports ==> VectorCategory R with
   vector : List R -> %
     ++ vector(l) converts the list l to a vector.
 Implementation ==>
  IndexedVector(R, VECTORMININDEX) add

     import from List(R)

     -- qelt and qsetelt! are logically unnecessary, but good for
     -- performance
     Qelt1 ==> QAREF1O$Lisp
     Qsetelt1 ==> QSETAREF1O$Lisp

     qelt(x, i) == Qelt1(x, i, VECTORMININDEX@Integer)
     qsetelt!(x, i, s) == Qsetelt1(x, i, s, VECTORMININDEX@Integer)

     vector l == construct l
     if R has ConvertibleTo InputForm then
       convert(x : %) : InputForm ==
          convert [convert('vector)@InputForm,
                          convert(parts x)@InputForm]


)abbrev package VECTOR2 VectorFunctions2
++ Author:
++ Basic Functions:
++ Related Constructors:
++ Also See:
++ AMS Classifications:
++ Keywords:
++ References:
++ Description:
++   This package provides operations which all take as arguments
++ vectors of elements of some type \spad{A} and functions from \spad{A} to
++ another of type B. The operations all iterate over their vector argument
++ and either return a value of type B or a vector over B.

VectorFunctions2(A, B) : Exports == Implementation where
  A, B : Type

  VA ==> Vector A
  VB ==> Vector B
  O2 ==> FiniteLinearAggregateFunctions2(A, VA, B, VB)
  UB ==> Union(B,"failed")

  Exports ==> with
    scan   : ((A, B) -> B, VA, B) -> VB
      ++ scan(func, vec, ident) creates a new vector whose elements are
      ++ the result of applying reduce to the binary function func,
      ++ increasing initial subsequences of the vector vec,
      ++ and the element ident.
    reduce : ((A, B) -> B, VA, B) -> B
      ++ reduce(func, vec, ident) combines the elements in vec using the
      ++ binary function func. Argument ident is returned if vec is empty.
    map    : (A -> B, VA) -> VB
      ++ map(f, v) applies the function f to every element of the vector v
      ++ producing a new vector containing the values.
    map : (A -> UB, VA) -> Union(VB,"failed")
      ++ map(f, v) applies the function f to every element of the vector v
      ++ producing a new vector containing the values or \spad{"failed"}.

  Implementation ==> add
    scan(f, v, b)   == scan(f, v, b)$O2
    reduce(f, v, b) == reduce(f, v, b)$O2
    map(f : (A->B), v : VA) : VB == map(f, v)$O2

    map(f:(A -> UB), a:VA):Union(VB,"failed") ==
     res : List B  := []
     for u in entries(a) repeat
       r := f u
       r = "failed" => return "failed"
       res := cons(r::B, res)
     vector reverse! res


)abbrev category DIRPCAT DirectProductCategory

--% DirectProductCategory

++ Author:
++ Basic Functions:
++ Related Constructors: DirectProduct
++ Also See: VectorCategory
++ AMS Classifications:
++ Keywords:
++ References:
++ Description:
++   This category represents a finite cartesian product of a given type.
++ Many categorical properties are preserved under this construction.

DirectProductCategory(dim : NonNegativeInteger, R : Type) : Category ==
  Join(IndexedAggregate(Integer, R), CoercibleTo Vector R, _
           AbelianProductCategory(R), finiteAggregate) with
           -- attribute to indicate an aggregate of finite size
         directProduct : Vector R -> %
           ++ directProduct(v) converts the vector v to
           ++ a direct product. Error: if the length of v is
           ++ different from dim.
         if R has SetCategory then FullyRetractableTo R
         if R has Ring then
           DifferentialExtension R
           FullyLinearlyExplicitOver R
         if R has AbelianMonoid and R has Monoid then
           unitVector : PositiveInteger -> %
             ++ unitVector(n) produces a vector with 1 in position n and
             ++ zero elsewhere.
         if R has SemiRng then
           SemiRng
           BiModule(R, R)
           if R has AbelianMonoid then
             dot : (%, %) -> R
               ++ dot(x, y) computes the inner product of the vectors x and y.
         if R has Monoid then Monoid
         if R has SemiGroup then
           SemiGroup
           _* : (R, %) -> %
             ++ r * y multiplies the element r times each component of the
             ++ vector y.
           _* : (%, R) -> %
             ++ y * r multiplies each component of the vector y by the element r.
         if R has Finite then Finite
         if R has CommutativeRing then
           Algebra R
           CommutativeRing
         if R has unitsKnown then unitsKnown
         if R has OrderedSet then OrderedSet
         if R has OrderedAbelianMonoid then OrderedAbelianMonoid
         if R has OrderedAbelianMonoidSup then OrderedAbelianMonoidSup
 add
      if R has Ring then
        equation2R : Vector % -> Matrix R

        coerce(n : Integer) : %          == n::R::%
        characteristic()             == characteristic()$R
        differentiate(z : %, d : R -> R) == map(d, z)

        equation2R v ==
          ans : Matrix(R) := new(dim, #v, 0)
          for i in minRowIndex ans .. maxRowIndex ans repeat
            for j in minColIndex ans .. maxColIndex ans repeat
              qsetelt!(ans, i, j, qelt(qelt(v, j), i))
          ans

        reducedSystem(m : Matrix %) : Matrix(R) ==
          empty? m => new(dim*nrows(m), ncols(m), 0)
          reduce(vertConcat, [equation2R row(m, i)
                 for i in minRowIndex m .. maxRowIndex m])$List(Matrix R)

        reducedSystem(m : Matrix %, v : Vector %):
          Record(mat : Matrix R, vec : Vector R) ==
            vh : Vector(R) :=
              empty? v => empty()
              rh := reducedSystem(v::Matrix %)@Matrix(R)
              column(rh, minColIndex rh)
            [reducedSystem(m)@Matrix(R), vh]

      if R has Finite then
          size() == size()$R ^ dim

          index n ==
              s := size()$R
              r := new(dim, index(1)$R)$Vector(R)
              n0 : Integer := n-1
              for i in 1..dim repeat
                  d := divide(n0, s)
                  r.i := index((1+d.remainder)::PositiveInteger)$R
                  n0 := d.quotient

              directProduct r

          lookup v ==
              s := size()$R
              pow : NonNegativeInteger := 1
              res : Integer := 1
              for i in 1..dim repeat
                  res := res + (lookup(v.i)$R - 1)*pow
                  pow := pow * s

              res::PositiveInteger


)abbrev domain DIRPROD DirectProduct
++ Author:
++ Basic Functions:
++ Related Constructors: Vector, IndexedVector
++ Also See: OrderedDirectProduct
++ AMS Classifications:
++ Keywords:
++ References:
++ Description:
++   This type represents the finite direct or cartesian product of an
++ underlying component type. This contrasts with simple vectors in that
++ the members can be viewed as having constant length. Thus many
++ categorical properties can by lifted from the underlying component type.
++ Component extraction operations are provided but no updating operations.
++ Thus new direct product elements can either be created by converting
++ vector elements using the \spadfun{directProduct} function
++ or by taking appropriate linear combinations of basis vectors provided
++ by the \spad{unitVector} operation.

DirectProduct(dim : NonNegativeInteger, R : Type):
    DirectProductCategory(dim, R) with
        if R has Hashable then Hashable
  == Vector R add

      Rep := Vector R

      coerce(z : %) : Vector(R)        == copy(z)$Rep pretend Vector(R)
      coerce(r : R) : %                == new(dim, r)$Rep

      parts x == VEC2LIST(x)$Lisp

      directProduct z ==
        size?(z, dim) => copy(z)$Rep
        error "Not of the correct length"

      if R has BasicType then
        same? : % -> Boolean
        same? z == (z1 := z(minIndex z); every?(x +-> x = z1, z))

        if R is NonNegativeInteger or R is Integer or R is PositiveInteger then
          -- This is a hack to gain speed.  Direct product is used
          -- by DistributedPolynomial and calling directly Lisp
          -- operation gives significant speedup.  Once compiler
          -- is smarter this hack will go away.
          x = y ==
            for i in 0..(dim - 1) repeat
                not EQL(QREFELT(x, i)$Lisp, QREFELT(y, i)$Lisp)$Lisp => return false
            true
        else
          x = y ==
            for i in 1..dim repeat
               not (qelt(x, i)$Rep = qelt(y, i)$Rep) => return false
            true
            -- _and/[qelt(x, i)$Rep = qelt(y, i)$Rep for i in 1..dim]

        retract(z : %) : R ==
          not(dim = 0) and same? z => z(minIndex z)
          error "Not retractable"

        retractIfCan(z:%):Union(R, "failed") ==
          not(dim = 0) and same? z => z(minIndex z)
          "failed"

      if R has Finite then
          index(n : PositiveInteger) : % ==
            N : Integer := size()$R
            p : Integer := n-1
            L : List R := [index(((p rem N) + 1)::PositiveInteger)$R]
            for i in 2..dim repeat
              p := p quo N
              L := cons(index(((p rem N) + 1)::PositiveInteger)$R, L)
            vector(L)
          random() == [random()$R for i in 1..dim]
          lookup(x) ==
            N : Integer := size()$R
            L : Integer := lookup(x.1)-1
            for i in 2..dim repeat
              L := L*N+lookup(x.i)-1
            (L+1)::PositiveInteger

      if R has AbelianMonoid then

        0 == zero(dim)$Vector(R) pretend %

      if R has SemiGroup then

        u : % * v : % == map(_*, u, v)$Rep

      if R has CancellationAbelianMonoid then
        tmp0 := new(dim, 0)$Rep

        subtractIfCan(u:%, v:%):Union(%,"failed") ==
          w := tmp0
          for i in 1..dim repeat
            (c := subtractIfCan(qelt(u, i)$Rep, qelt(v,i)$Rep)) case "failed" =>
                    return "failed"
            qsetelt!(w, i, c@R)$Rep
          copy(w)$Rep

      if R has Monoid then

        1 == new(dim, 1)$Vector(R) pretend %

        tmp1 := new(dim, 1)$Rep

        recip z ==
          w := tmp1
          for i in 1..dim repeat
            (u := recip qelt(z, i)) case "failed" => return "failed"
            qsetelt!(w, i, u@R)
          copy(w)$Rep

      if R has AbelianMonoid and R has Monoid then

        unitVector i ==
          v := new(dim, 0)$Vector(R)
          v.i := 1
          v pretend %

      if R has OrderedSet then

          -- Duplicated to gain speed via inlining of '<' in integer case.
          if R is NonNegativeInteger or R is Integer or
                                        R is PositiveInteger then
              x < y ==
                  for i in 0..(dim - 1) repeat
                      a : R := QREFELT(x, i)$Lisp
                      b : R := QREFELT(y, i)$Lisp
                      a < b => return true
                      b < a => return false
                  false
          else
              x < y ==
                  for i in 0..(dim - 1) repeat
                      a : R := QREFELT(x, i)$Lisp
                      b : R := QREFELT(y, i)$Lisp
                      a < b => return true
                      b < a => return false
                  false

      if R has OrderedAbelianMonoidSup then sup(x, y) == map(sup, x, y)


)abbrev package DIRPROD2 DirectProductFunctions2
++ Author:
++ Basic Functions:
++ Related Constructors:
++ Also See:
++ AMS Classifications:
++ Keywords:
++ References:
++ Description:
++   This package provides operations which all take as arguments
++ direct products of elements of some type \spad{A} and functions from \spad{A} to another
++ type B. The operations all iterate over their vector argument
++ and either return a value of type B or a direct product over B.

DirectProductFunctions2(dim, A, B) : Exports == Implementation where
  dim : NonNegativeInteger
  A, B : Type

  DA ==> DirectProduct(dim, A)
  DB ==> DirectProduct(dim, B)
  VA ==> Vector A
  VB ==> Vector B
  O2 ==> FiniteLinearAggregateFunctions2(A, VA, B, VB)

  Exports ==> with
    scan   : ((A, B) -> B, DA, B) -> DB
      ++ scan(func, vec, ident) creates a new vector whose elements are
      ++ the result of applying reduce to the binary function func,
      ++ increasing initial subsequences of the vector vec,
      ++ and the element ident.
    reduce : ((A, B) -> B, DA, B) -> B
      ++ reduce(func, vec, ident) combines the elements in vec using the
      ++ binary function func. Argument ident is returned if the vector is empty.
    map    : (A -> B, DA) -> DB
      ++ map(f, v) applies the function f to every element of the vector v
      ++ producing a new vector containing the values.

  Implementation ==> add
    import from FiniteLinearAggregateFunctions2(A, VA, B, VB)

    map(f, v)       == directProduct map(f, v::VA)
    scan(f, v, b)   == directProduct scan(f, v::VA, b)
    reduce(f, v, b) == reduce(f, v::VA, b)

)abbrev domain DPMO DirectProductModule
++ Author:  Stephen M. Watt
++ Date Created: 1986
++ Basic Operations:
++ Related Domains:
++ Also See:
++ AMS Classifications:
++ Keywords: equation
++ Examples:
++ References:
++ Description:
++   This constructor provides a direct product of R-modules
++   with an R-module view.
-- Currently unused.
DirectProductModule(n, R, S) : DPcategory == DPcapsule where
    n : NonNegativeInteger
    R : Ring
    S : LeftModule(R)

    DPcategory == Join(DirectProductCategory(n, S), LeftModule(R))
    --  with if S has Algebra(R) then Algebra(R)
    --  <above line leads to matchMmCond: unknown form of condition>

    DPcapsule == DirectProduct(n, S) add
        Rep := Vector(S)
        r : R * x : % == [r * x.i for i in 1..n]

)abbrev domain DPMM DirectProductMatrixModule
++ Author:  Stephen M. Watt
++ Date Created: 1986
++ Basic Operations:
++ Related Domains:
++ Also See:
++ AMS Classifications:
++ Keywords: equation
++ Examples:
++ References:
++ Description:
++   This constructor provides a direct product type with a
++   left matrix-module view.
-- Currently unused.
DirectProductMatrixModule(n, R, M, S) : DPcategory == DPcapsule where
    n : PositiveInteger
    R : Ring
    RowCol ==> DirectProduct(n, R)
    M : SquareMatrixCategory(n, R, RowCol, RowCol)
    S : LeftModule(R)

    DPcategory == Join(DirectProductCategory(n, S), LeftModule(R), LeftModule(M))

    DPcapsule == DirectProduct(n, S) add
        Rep := Vector(S)
        r : R * x : % == [r*x.i for i in 1..n]
        m : M * x : % == [ +/[m(i, j)*x.j for j in 1..n] for i in 1..n]

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