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

**Re: Q: efficient in-place list element replacement?**

**Re: MathLink & strings**

**Re: Mathematica and Topology.**

**intersection of 3d contours**