)abbrev package UGAUSS UnitGaussianElimination
++ References:
++   J-G. Dumas, F. Heckenbach, D. Sauders, V. Welker:
++   Computing simplicial homology based on efficient Smith
++   normal form algorithms.
++ Description: Gaussian elimination using only 1 or -1 as pivots
++

UnitGaussianElimination : with
    pre_gauss : Matrix(Integer) -> Matrix(Integer)
      ++ pre_gauss(m) performs Gaussian eliminaton on rows of m
      ++ using only 1 and -1 as pivots.
      ++ Note:  m is modified in place
    pre_smith : Matrix(Integer) -> Matrix(Integer)
      ++ pre_smith(m) first performs pre_gauss(m) and then
      ++ drops all rows and columns of m containing pivots.
    pre_lr : (Matrix(Integer), Vector(Integer), Vector(Integer)
             ) -> Matrix(Integer)
      ++ pre_lr(m, pi, pj) is like pre_gauss, but records positions
      ++ of pivots in pi and pj and returns transformation matrix.
      ++ m, pi, pj are modified in place
  == add

    M ==> Matrix(Integer)
    V ==> Vector(Integer)
    NNI ==> NonNegativeInteger

    -- Gaussian elimination using only 1 or -1 as pivots
    -- m is input matrix,
    -- pivotsj is position of pivot within row, 0 if none
    -- pivotsk is position of pivot within column, 0 if none
    -- pivotsj and pivotsk are 0 on entry and filled with
    -- appropriate values on exit
    pre_lr0(m, pivotsj, pivotsk, adjust) ==>
        j := nrows(m)
        k := ncols(m)
        for i in 1..j repeat
            -- choose pivot in row i
            for l in 1..k repeat
                pivotsk(l) ~= 0 => iterate
                pv := qelt(m, i, l)
                if pv = 1 or pv = -1 then
                     pivotsj(i) := l
                     pivotsk(l) := i
                     break
            pivotsj(i) = 0 => iterate
            l0 := pivotsj(i)
            ml := qelt(m, i, l0)
            -- zero out column l0, do not bother with rows containing pivots
            for n in 1..j repeat
                if qelt(pivotsj, n) = 0 and qelt(m, n, l0) ~= 0 then
                    pp := -ml*qelt(m, n, l0)
                    for l in 1..k repeat
                        qsetelt!(m, n, l, qelt(m, n, l) + pp*qelt(m, i, l))
                    adjust

    pre_gauss0(m : M, pivotsj : V, pivotsk : V) : Void ==
        pre_lr0(m, pivotsj, pivotsk, 0)

    pre_lr(m : M, pivotsj : V, pivotsk : V) : M ==
        m2 := scalarMatrix(nrows(m), 1)$M
        adjust ==>
            for l in 1..j repeat
                qsetelt!(m2, n, l, qelt(m2, n, l) + pp*qelt(m2, i, l))
        pre_lr0(m, pivotsj, pivotsk, adjust)
        m2

    pre_gauss(m : M) : M ==
        j := nrows(m)
        k := ncols(m)
        pivotsj := zero(j)$V
        pivotsk := zero(k)$V
        pre_gauss0(m, pivotsj, pivotsk)
        m

    pre_smith(m : M) : M ==
        j := nrows(m)
        k := ncols(m)
        pivotsj := zero(j)$V
        pivotsk := zero(k)$V
        pre_gauss0(m, pivotsj, pivotsk)

        -- count rows containing pivots
        count := 0
        for i in 1..j repeat
            if pivotsj(i) ~= 0 then
                count := count + 1
        count = 0 => m
        -- skip rows and columns containing pivots
        ress := zero((j - count)::NNI, (k - count)::NNI)$M
        i0 := 0
        for i in 1..j repeat
            if pivotsj(i) = 0 then
                i0 := i0 + 1
                l0 := 0
                for l in 1..k repeat
                    if qelt(pivotsk, l) = 0 then
                        l0 := l0 + 1
                        qsetelt!(ress, i0, l0, qelt(m, i, l))
        ress


)abbrev package ISMITH IntegerSmithNormalForm
++ Description: This package computes Smith form of integer matrices.
++  It is more efficinet than general case by first using elimination
++  with unit pivots from \spadtype{UnitGaussianElimination}.

M ==> Matrix(Integer)
SmithForm ==> Record(Smith : M, leftEqMat : M, rightEqMat : M)
IntegerSmithNormalForm : with

    smith : M -> M
      ++ smith(m) computes Smith normal form of m
    smith : (M, M -> M) -> M
      ++ smith(m, full) computes Smith normal form of m.  It
      ++ first reduces m to smaller matrix and then uses full
      ++ to finish.
    completeSmith : (M, M -> SmithForm) -> SmithForm
      ++ completeSmith(m, full) computes record containing Smith normal
      ++ form of m and the left and right equivalence matrices.
      ++ It first reduces m to smaller matrix and then uses full
      ++ to finish.

  == add

    PS ==> UnitGaussianElimination
    V ==> Vector(Integer)
    SP ==> SmithNormalForm(Integer, V, V, M)

    smith(m : M, full : M -> M) : M ==
        m1 := copy(m)
        m2 := pre_smith(m1)$PS
        m3 := full(m2)
        j := nrows(m)
        k := ncols(m)
        nn := min(j, k)
        count := j - nrows(m2)
        res := zero(j, k)$M
        for i in 1..count repeat
            qsetelt!(res, i, i, 1)
        nn2 := nn - count
        for i in 1..nn2 repeat
            qsetelt!(res, i + count, i + count, qelt(m3, i, i))
        res

    smith(m : M) : M == smith(m, smith$SP)

    completeSmith(m : M, full : M -> SmithForm) : SmithForm ==
        j := nrows(m)
        k := ncols(m)
        j > k =>
            res0 := completeSmith(transpose(m), full)
            [transpose(res0.Smith), transpose(res0.rightEqMat),
              transpose(res0.leftEqMat)]
        pivotsj := zero(j)$V
        pivotsk := zero(k)$V
        m1 := copy(m)
        m2 := pre_lr(m1, pivotsj, pivotsk)$PS
        lj0 : List(Integer) := [i for i in 1..j | pivotsj(i) = 0]
        lj1 : List(Integer) := [s for i in 1..j | (s := pivotsj(i)) ~= 0]
        lj2 : List(Integer) := [i for i in 1..j | pivotsj(i) ~= 0]
        lk0 : List(Integer) := [i for i in 1..k | pivotsk(i) = 0]
        ljs := concat(lj2, lj0)
        lks := concat(lj1, lk0)
        m3 := m1(ljs, lks)
        m4 := m2(ljs, 1..j)
        count := #lj2
        m5 := m3((count + 1)..j, (count + 1)..k)
        res1 := full(m5)
        m6 := m4((count + 1)..j, 1..j)
        m7 := res1.leftEqMat*m6
        m8 := vertConcat(m4(1..count, 1..j), m7)
        m9 := m3((count + 1)..j, 1..k)
        m10 := res1.leftEqMat*m9
        m11 := vertConcat(m3(1..count, 1..k), m10)
        m12 := zero(k, k)$M
        for i in 1..k for l in lks repeat
            m12(l, i) := 1
        m13 := m12(1..k, (count + 1)..k)*res1.rightEqMat
        m14 := horizConcat(m12(1..k, 1..count), m13)
        m15 := m11(1..j, (count + 1)..k)*res1.rightEqMat
        m16 := horizConcat(m11(1..j, 1..count), m15)
        for i in count..1 by -1 repeat
            if qelt(m16, i, i) = -1 then
                for l in 1..i repeat
                    qsetelt!(m16, l, i, -qelt(m16, l, i))
                for l in 1..k repeat
                    qsetelt!(m14, l, i, -qelt(m14, l, i))
            qelt(m16, i, i) ~= 1 =>
                error "completeSmith: wrong diagonal"
            for l in 1..(i - 1) repeat
                pp := qelt(m16, l, i)
                for n in (i + 1)..k repeat
                    qsetelt!(m16, l, n, qelt(m16, l, n) - pp*qelt(m16, i, n))
            for l in 1..k repeat
                pp := qelt(m14, l, i)
                for n in (i + 1)..k repeat
                    qsetelt!(m14, l, n, qelt(m14, l, n) - pp*qelt(m16, i, n))
            for n in (i + 1)..k repeat qsetelt!(m16, i, n,  0)
        [m16, m8, m14]
