Re: Mathematica and Topology.
- To: mathgroup at smc.vnet.net
- Subject: [mg21194] Re: Mathematica and Topology.
- From: Daniel Lichtblau <danl at wolfram.com>
- Date: Fri, 17 Dec 1999 01:24:09 -0500 (EST)
- Organization: Wolfram Research, Inc.
- References: <831isk$dgb@smc.vnet.net>
- Sender: owner-wri-mathgroup at wolfram.com
J Nambia wrote:
>
> I am currently considering buying Mathematica for Students 4.0 to tackle a
> specific problem: calculating connectivity trees for large graphs, given a
> connectivity matrix of that graph. (I am an economics student, not a
> mathematician, so please forgive mistakes of a terminology nature...)
>
> I was wondering if anyone had any advice or, even better, if anybody out
> there has done something similair (or heard about how someone else did it).
>
> In actual fact I plan to investigate how the topological configuration of
> inner Milan (Italy) affects commerce and see if the facts bourne out by the
> "Space Syntax" theory of urban development.
>
> Any input gladly accepted; answers on the newsgroup or by email.
>
> J Nambia
In some private e-mail it was specified that, among other things,
average path length from any given vertex to the other vertices was of
considerable interest (and moreover it is desired to handle graphs with
over 1000 vertices). The code below can be used for this task although
it may be stretched a bit due to algorithm complexity (see below).
Here is an outline of the method. We find vertex pairs for which there
is a path of length k by taking the kth matrix power. We remove from
consideration all such pairs for which there is a shorter path. These we
obtain by summing over smaller powers. For our purposes we require a
funny arithmetic wherein 0+0 is 1 and all other sums are 1. As we do not
count paths from a vertex to itself, our average has length-1 in the
denominator. Also be aware that we implicitly assume the graph is
connected; otherwise our averages are not correct (but see comments re
examples below).
normalize[mat_] := Map[If[#>0, 1, 0]&, mat, {2}]
averagepathlengths[mat_] := Module[
{matpower, matsum, pathsums, len=Length[mat],
nvec, lastsum, lastpower, tmpsums},
lastsum = IdentityMatrix[len];
lastpower = lastsum;
pathsums = Transpose[Table[
matpower = normalize[mat . lastpower];
tmpsums = Map[Apply[Plus,#]&,
normalize[matpower - lastsum]];
lastsum = normalize[matpower + lastsum];
lastpower = matpower;
tmpsums,
{j, len}]];
nvec = Range[len];
Map[nvec.#/(len-1)&, pathsums]
]
To demonstrate we can take a random undirected graph.
adjmat[dim_, prob_] := Table[If[Random[] > prob, 1, 0], {dim}, {dim}]
tmp = adjmat[12, .9];
In[60]:= InputForm[amat = Mod[tmp + Transpose[tmp], 2]]
Out[60]//InputForm=
{{0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0}, {0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 1,
1},
{1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1,
0},
{0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0,
0},
{0, 1, 0, 1, 0, 0, 0, 1, 1, 0, 0, 0}, {0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0,
0},
{0, 0, 0, 0, 1, 1, 1, 0, 0, 1, 0, 0}, {1, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0,
0},
{0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1}, {0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1,
0}}
Out[61]//InputForm=
{27/11, 21/11, 31/11, 26/11, 31/11, 31/11, 19/11, 25/11, 21/11, 21/11,
28/11,
29/11}
This sort of random example is flawed in that
(i) The random graphs need not be connected, and so "average" lengths
may not be computed correctly (but we still get a correct indication of
the speed), and
(ii) It is not representative of the sort of problem that was requested.
A more realistic example for an urban grid might be formulated by
taking, say, a 20 x 20 grid, connecting all vertical and horizontal
neighbors, randomly removing a number of the connections (symmetrically,
of course), and perhaps randomly adding a few diagonal connections to
simulate Columbus Avenue. The lattice points then give 400 vertices and
the connections give rise to the graph connectivity matrix.
So what can we say about the speed? First, the algorithm is going to be
O(n^4) where n is the number of vertices, because each matrix product is
O(n^3). While this is not promising, we can certainly hope to handle an
example in this size range overnight. To demonstrate I do an example of
dimension 200.
In[62]:= tmp = adjmat[200, .003];
In[63]:= amat = Mod[tmp + Transpose[tmp], 2];
In[64]:= averagepathlengths[amat]; // Timing
Out[64]= 1243.04*Second
A 100 x 100 random example took about 77 seconds, exactly as would be
predicted by O(n^4) complexity. This indicates that the 400 x 400 case
might take around five or six hours. One thing I find encouraging is
that our development version the 100 x 100 case takes only 18 seconds on
the same machine. A factor-of-four speed gain would bring the
1000-vertex case down to a mere two or three day ordeal.
The code above is a close relative of some graph connectivity code
snippets I wrote up for talk at our October Mathematica Developer
Conference. For those with an interest in such things, it can be found
at:
http://library.wolfram.com/conferences/devconf99/
in the programming section.
Daniel Lichtblau
Wolfram Research