axiom-source 20170501-3 / usr / share / axiom-20170501 / src / algebra / IFARRAY.spad

)abbrev domain IFARRAY IndexedFlexibleArray
++ Author: Michael Monagan July/87, modified SMW June/91
++ Description:
++ A FlexibleArray is the notion of an array intended to allow for growth
++ at the end only.  Hence the following efficient operations\br
++ \spad{append(x,a)} meaning append item x at the end of the array \spad{a}\br
++ \spad{delete(a,n)} meaning delete the last item from the array \spad{a}\br
++ Flexible arrays support the other operations inherited from
++ \spadtype{ExtensibleLinearAggregate}. However, these are not efficient.
++ Flexible arrays combine the \spad{O(1)} access time property of arrays
++ with growing and shrinking at the end in \spad{O(1)} (average) time.
++ This is done by using an ordinary array which may have zero or more
++ empty slots at the end.  When the array becomes full it is copied
++ into a new larger (50% larger) array.  Conversely, when the array
++ becomes less than 1/2 full, it is copied into a smaller array.
++ Flexible arrays provide for an efficient implementation of many
++ data structures in particular heaps, stacks and sets.

IndexedFlexibleArray(S,mn) : SIG == CODE where
  S : Type
  mn : Integer

  A ==> PrimitiveArray S
  I ==> Integer
  N ==> NonNegativeInteger
  U ==> UniversalSegment Integer

  SIG ==> Join(OneDimensionalArrayAggregate S,ExtensibleLinearAggregate S) with

    flexibleArray : List S -> %
     ++ flexibleArray(l) creates a flexible array from the list of elements l
     ++
     ++X T1:=IndexedFlexibleArray(Integer,20)
     ++X flexibleArray([i for i in 1..10])$T1

    physicalLength : % -> NonNegativeInteger
     ++ physicalLength(x) returns the number of elements x can 
     ++ accomodate before growing
     ++
     ++X T1:=IndexedFlexibleArray(Integer,20)
     ++X t2:=flexibleArray([i for i in 1..10])$T1
     ++X physicalLength t2

    physicalLength_! : (%, I) -> %
     ++ physicalLength!(x,n) changes the physical length of x to be n and
     ++ returns the new array.
     ++
     ++X T1:=IndexedFlexibleArray(Integer,20)
     ++X t2:=flexibleArray([i for i in 1..10])$T1
     ++X physicalLength!(t2,15)

    shrinkable : Boolean -> Boolean
     ++ shrinkable(b) sets the shrinkable attribute of flexible arrays to b
     ++ and returns the previous value
     ++
     ++X T1:=IndexedFlexibleArray(Integer,20)
     ++X shrinkable(false)$T1

  CODE ==> add

    Rep := Record(physLen:I, logLen:I, f:A)
    shrinkable? : Boolean := true
    growAndFill : (%, I, S) -> %
    growWith    : (%, I, S) -> %
    growAdding  : (%, I, %) -> %
    shrink: (%, I)    -> %
    newa  : (N, A) -> A

    physicalLength(r) == (r.physLen) pretend NonNegativeInteger

    physicalLength_!(r, n) ==
       r.physLen = 0  => error "flexible array must be non-empty"
       growWith(r, n, r.f.0)

    empty()      == [0, 0, empty()]

    #r           == (r.logLen)::N

    fill_!(r, x) == (fill_!(r.f, x); r)

    maxIndex r   == r.logLen - 1 + mn

    minIndex r   == mn

    new(n, a)    == [n, n, new(n, a)]

    shrinkable(b) ==
      oldval := shrinkable?
      shrinkable? := b
      oldval

    flexibleArray l ==
       n := #l
       n = 0 => empty()
       x := l.1
       a := new(n,x)
       for i in mn + 1..mn + n-1 for y in rest l repeat a.i := y
       a

    -- local utility operations
    newa(n, a) ==
       zero? n => empty()
       new(n, a.0)

    growAdding(r, b, s) ==
       b = 0 => r
       #r > 0 => growAndFill(r, b, (r.f).0)
       #s > 0 => growAndFill(r, b, (s.f).0)
       error "no default filler element"

    growAndFill(r, b, x) ==
       (r.logLen := r.logLen + b) <= r.physLen => r
       -- enlarge by 50% + b
       n := r.physLen + r.physLen quo 2 + 1
       if r.logLen > n then n := r.logLen
       growWith(r, n, x)

    growWith(r, n, x) ==
       y := new(n::N, x)$PrimitiveArray(S)
       a := r.f
       for k in 0 .. r.physLen-1 repeat y.k := a.k
       r.physLen := n
       r.f := y
       r

    shrink(r, i) ==
       r.logLen := r.logLen - i
       negative?(n := r.logLen) => error "internal bug in flexible array"
       2*n+2 > r.physLen => r
       not shrinkable? => r
       if n < r.logLen 
         then error "cannot shrink flexible array to indicated size"
       n = 0 => empty()
       r.physLen := n
       y := newa(n::N, a := r.f)
       for k in 0 .. n-1 repeat y.k := a.k
       r.f := y
       r

    copy r ==
       n := #r
       a := r.f
       v := newa(n, a := r.f)
       for k in 0..n-1 repeat v.k := a.k
       [n, n, v]


    elt(r:%, i:I) ==
       i < mn or i >= r.logLen + mn =>
           error "index out of range"
       r.f.(i-mn)

    setelt(r:%, i:I, x:S) ==
       i < mn or i >= r.logLen + mn =>
           error "index out of range"
       r.f.(i-mn) := x

    -- operations inherited from extensible aggregate

    merge(g, a, b)   == merge_!(g, copy a, b)

    concat(x:S, r:%) == insert_!(x, r, mn)

    concat_!(r:%, x:S) ==
       growAndFill(r, 1, x)
       r.f.(r.logLen-1) := x
       r

    concat_!(a:%, b:%) ==
       if eq?(a, b) then b := copy b
       n := #a
       growAdding(a, #b, b)
       copyInto_!(a, b, n + mn)

    remove_!(g:(S->Boolean), a:%) ==
       k:I := 0
       for i in 0..maxIndex a - mn repeat
          if not g(a.i) then (a.k := a.i; k := k+1)
       shrink(a, #a - k)

    delete_!(r:%, i1:I) ==
       i := i1 - mn
       i < 0 or i > r.logLen => error "index out of range"
       for k in i..r.logLen-2 repeat r.f.k := r.f.(k+1)
       shrink(r, 1)

    delete_!(r:%, i:U) ==
       l := lo i - mn; m := maxIndex r - mn
       h := (hasHi i => hi i - mn; m)
       l < 0 or h > m => error "index out of range"
       for j in l.. for k in h+1..m repeat r.f.j := r.f.k
       shrink(r, max(0,h-l+1))

    insert_!(x:S, r:%, i1:I):% ==
       i := i1 - mn
       n := r.logLen
       i < 0 or i > n => error "index out of range"
       growAndFill(r, 1, x)
       for k in n-1 .. i by -1 repeat r.f.(k+1) := r.f.k
       r.f.i := x
       r

    insert_!(a:%, b:%, i1:I):% ==
       i := i1 - mn
       if eq?(a, b) then b := copy b
       m := #a; n := #b
       i < 0 or i > n => error "index out of range"
       growAdding(b, m, a)
       for k in n-1 .. i by -1 repeat b.f.(m+k) := b.f.k
       for k in m-1 .. 0 by -1 repeat b.f.(i+k) := a.f.k
       b

    merge_!(g, a, b) ==
       m := #a; n := #b; growAdding(a, n, b)
       for i in m-1..0 by -1 for j in m+n-1.. by -1 repeat a.f.j := a.f.i
       i := n; j := 0
       for k in 0.. while i < n+m and j < n repeat
          if g(a.f.i,b.f.j) then (a.f.k := a.f.i; i := i+1)
          else (a.f.k := b.f.j; j := j+1)
       for k in k.. for j in j..n-1 repeat a.f.k := b.f.j
       a

    select_!(g:(S->Boolean), a:%) ==
       k:I := 0
       for i in 0..maxIndex a - mn repeat_
          if g(a.f.i) then (a.f.k := a.f.i;k := k+1)
       shrink(a, #a - k)

    if S has SetCategory then

      removeDuplicates_! a ==
         ct := #a
         ct < 2 => a

         i     := mn
         nlim  := mn + ct
         nlim0 := nlim
         while i < nlim repeat
            j := i+1
            for k in j..nlim-1 | a.k ^= a.i repeat
                a.j := a.k
                j := j+1
            nlim := j
            i := i+1
         nlim ^= nlim0 => delete_!(a, i..)
         a