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
>
>
>