MathGroup Archive 1995

[Date Index] [Thread Index] [Author Index]

Search the Archive

Re: RealDigits

  • To: mathgroup at christensen.cybernetics.net
  • Subject: [mg1869] Re: [mg1741] RealDigits
  • From: Count Dracula <lk3a at kelvin.seas.virginia.edu>
  • Date: Wed, 9 Aug 1995 22:39:32 -0400
  • Organization: University of Virginia

(Dave Wagner) wagner at bullwinkle.cs.Colorado.EDU  writes:

>    UpperTriangularQ[m_] :=
>	And @@ Flatten[ MapIndexed[ #1==0 || LessEqual @@ #2 &, m, {2} ]]

> It's similarly easy to write predicates for lower triangular, tridiagonal,
> Toeplitz, etc, etc.

> If anybody has a better way to do this sort of thing, I'd love to see it.

Here are some functions related to this:

UpperTriangularQ[m_?MatrixQ] /; SameQ @@ Dimensions[m]  := 
  Length @ Complement[ Join @@ MapThread[Take, {m, Range[0, Length[m] - 1]}], {0, 0.0}] == 0

UpperTriangularQ[___] := False

LowerTriangularQ[m_?MatrixQ] /; SameQ @@ Dimensions[m] :=
  Length @ Complement[ Join @@ MapThread[Drop, {m, Range[Length[m]]}], {0, 0.0}] == 0

LowerTriangularQ[___] := False

BandedQ[m_?MatrixQ, w_Integer?NonNegative] /; SameQ @@ Dimensions[m]  := 
    Module[{n = Length[m], index},
(* w = 0 for a diagonal matrix
   w = 1, for a 3-diagonal matrix
   w = 2 for a 5-diagonal matrix
   w = k for a (2 k + 1)-diagonal matrix *)
      If[ w > n - 1, Return[False]];
      index = Transpose[{
         Join[Table[1, {w}], Range[n - w]], Join[Range[1 + w, n], Table[n, {w}]]
                       }];
      Length @ Complement[ Join @@ MapThread[Drop, {m, index}], {0, 0.0}] == 0
          ]

BandedQ[___] := False

BandWidth[m_?MatrixQ] /; SameQ @@ Dimensions[m]  :=
    Module[{n = Length[m] - 1, k},
      k = 0;
      While[ Not[BandedQ[m, k]] && k < n, k = k + 1 ];
      2 k + 1
          ]

BandWidth[___] := 0

ToeplitzQ[m_?MatrixQ] /; SameQ @@ Dimensions[m]  := 
    Module[{row, last},
      row = First[m]; 
      last = Drop[Last[m], -1];
      m == Map[ Join[Take[last, -#1], Drop[row, -#1]] &, Range[0, Length[m] - 1] ]
          ]

ToeplitzQ[___] := False

-- 
___________________________________________________________________________________
Levent Kitis           lk3a at cars.mech.virginia.edu    lk3a at kelvin.seas.virginia.edu
University of Virginia Department of Mechanical, Aerospace, and Nuclear Engineering  


  • Prev by Date: Fuzzy in mathematica
  • Next by Date: Comparison of Mma animations on various machines
  • Previous by thread: Re: RealDigits
  • Next by thread: Re: RealDigits