Re: RealDigits

*To*: mathgroup at christensen.cybernetics.net*Subject*: [mg1875] Re: [mg1741] RealDigits*From*: wagner at bullwinkle.cs.Colorado.EDU (Dave Wagner)*Date*: Wed, 9 Aug 1995 22:40:36 -0400*Organization*: University of Colorado, Boulder

In article <DCyuBq.n1p at wri.com>, Count Dracula <lk3a at kelvin.seas.virginia.edu> wrote: >(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. Levent Kitis has posted several clever functions for computing these predicates. Since he's done so, I'll post my solutions that use MapIndexed. Their performance is surely poorer than Mr. Kitis' versions, and I make no other claims about them because I don't want to start a religious war. I leave the judgement of which versions are "better" to the individual readers of the group. Mr. Kitis' versions are included at the end of this posting for purposes of comparison. DiagonalQ[m_?MatrixQ] /; SameQ @@ Dimensions[m] := And @@ Flatten @ MapIndexed[#1==0 || Equal @@ #2 &, m, {2}] UpperTriangularQ[m_?MatrixQ] /; SameQ @@ Dimensions[m] := And @@ Flatten @ MapIndexed[#1==0 || LessEqual @@ #2 &, m, {2}] LowerTriangularQ[m_?MatrixQ] /; SameQ @@ Dimensions[m] := And @@ Flatten @ MapIndexed[#1==0 || GreaterEqual @@ #2 &, m, {2}] BandedQ[m_?MatrixQ, w_Integer] /; SameQ @@ Dimensions[m] := (* w is the bandwidth *) And @@ Flatten @ MapIndexed[#1==0 || Abs[Subtract @@ #2] <= w &, m, {2}] ToeplitzQ[m_?MatrixQ] /; SameQ @@ Dimensions[m] := And @@ Flatten @ MapIndexed[Times @@ (#2-1) == 0 || #1 == m[[Sequence @@ (#2-1)]] &, m, {2}] (In ToeplitzQ, the first condition in the pure function checks to see if the element in question is along the top or left edge of the matrix.) All of these worked the first time with the exception of ToeplitzQ, for which I had operator precedence problems that were solved with the parentheses around the subexpressions "#2-1". Total time to write all 5 functions: about 5 minutes. Incidentally, there also was some discussion about the problem with the And @@ Map... paradigm, which is that all of the conditions are checked even if the first one turns out to be false. There actually is a nice way to get around this problem that involves held expressions, but it complicates the code so I didn't include it in my original posting. Here's the basic idea: suppose you wanted to check all elements of a list to see if they satisfy some predicate. (Forget about the fact that ListQ can do this for you). The straightforward, inefficient way to do this is: And @@ predicate /@ list This is inefficient because, even if the first element of the list doesn't satisfy the predicate, they are all checked. This problem can be avoid as follows: And @@ predicate /@ Hold @@ list What happens here is that none of the predicates evaluate until And is applied. And then evaluates its arguments sequentially, stopping as soon as one of them is False. This method may be slightly slower when the eventual result is True, but it has the potential to be much faster for large lists when the eventual result is False. This technique can also be extended to matrix predicates as follows: Rather than And @@ Flatten @ MapIndexed[predicate, matrix, {2}] do this: And @@ Flatten[#, 1, Hold]& @ MapIndexed[predicate, matrix /. List->Hold, {2}] Or the following alternative, which I include to save Allan Hayes the trouble of posting it: :-) Block[{And, predicate}, And @@ Flatten @ MapIndexed[predicate, matrix, {2}] ] Of course, the Block trick requires one to refer to the predicate using a symbolic name, rather than an in-line pure function. Dave Wagner Principia Consulting (303) 786-8371 dbwagner at princon.com http://www.princon.com/princon >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 > >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 > > >