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