Mathematica 9 is now available
Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
1995
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*November
*December
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 1995

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

Search the Archive

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




  • Prev by Date: Re: RealDigits
  • Next by Date: MapIndexed (was: Re: RealDigits)
  • Previous by thread: Re: RealDigits
  • Next by thread: Fit[] problem