share/contrib/state/matrix2.mac

   1 /*
   2 This subroutine does some matrix manipulations
   3 Copyright (C) 1999  Dan Stanger
   4
   5 This library is free software; you can redistribute it and/or modify it
   6 under the terms of the GNU Library General Public License as published
   7 by the Free Software Foundation; either version 2 of the License, or (at
   8 your option) any later version.
   9
  10 This library is distributed in the hope that it will be useful, but
  11 WITHOUT ANY WARRANTY; without even the implied warranty of
  12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13 Library General Public License for more details.
  14
  15 You should have received a copy of the GNU Library General Public
  16 License along with this library; if not, write to the Free Software
  17 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA
  18
  19 Dan Stanger dan.stanger@ieee.org
  20 */
  21 /* these routines are here because of inconsistent behavior in mat_unblocker
  22    if the matrix created by matrix([matrix(),matrix([r])],[matrix(),matrix()])
  23    is passed into mat_unblocker, the result is matrix().  i would expect
  24    that this is a error or that the matrix [r] is returned.
  25    also if zeromatrix is passed 0,0 then the result is matrix(), 0,1 yields
  26    matrix() also, but 1,0 yields matrix([]). */
  27 matrix2([l]):=matrix2aux(matrix(),apply(matrix,l))$
  28 matrix2aux(em,mat):=block([w:false,n,m],
  29  block([ae:false,af:true], /* test matrix of all empty matrixes */
  30   matrixmap(lambda([i],if i # em then ae:true else af:false), mat),
  31   if ae = false then em
  32   else(
  33   if af then mat_unblocker(mat)
  34   else (
  35     block([e:false, c:col(mat,1)],
  36         matrixmap(lambda([i],if i # em then e:true), c),
  37         if e = false then (mat:submatrix(mat,1), w:true)),
  38     block([e:false, c:col(mat,n:mat_ncols(mat))],
  39         matrixmap(lambda([i],if i # em then e:true), c),
  40         if e = false then (mat:submatrix(mat,n), w:true)),
  41     block([e:false, r:row(mat,1)],
  42         matrixmap(lambda([i],if i # em then e:true), r),
  43         if e = false then (mat:submatrix(1,mat), w:true)),
  44     block([e:false, r:row(mat,m:mat_nrows(mat))],
  45         matrixmap(lambda([i],if i # em then e:true), r),
  46         if e = false then (mat:submatrix(m, mat), w:true)),
  47     if w = true then mat:matrix2aux(em,mat)
  48     else mat:blockmat(mat),
  49     if matrixp(mat) and mat_nrows(mat) = 1 and mat_ncols(mat) = 1 then mat[1,1]
  50     else mat
  51   )
  52  ))
  53 )$
  54 zeromatrix2(m,n):=if m = 0 or n = 0 then matrix() else zeromatrix(m,n)$
  55 submat_m(om,im,m,n)::=buildq([om,im,m,n],
  56         (om:submat(im,m,n),put('om, length(m),'nrow),
  57         put('om,length(n),'ncol)))$
  58 mat_nrows_m(om)::=buildq([om],get('om,'nrow))$
  59 mat_ncols_m(om)::=buildq([om],get('om,'ncol))$