Services & ResourcesWolfram ForumsMathGroup Archive

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

Re: Constructing a huge graph

• To: mathgroup at smc.vnet.net
• Subject: [mg122101] Re: Constructing a huge graph
• From: Daniel Lichtblau <danl at wolfram.com>
• Date: Fri, 14 Oct 2011 05:52:53 -0400 (EDT)
• Delivered-to: l-mathgroup@mail-archive0.wolfram.com
• References: <201110130747.DAA02343@smc.vnet.net>

On 10/13/2011 02:47 AM, Martin wrote:
> Hi
>
> I am currently trying to construct a very large weighted graph but I
> find myself in huge troubles :-). I simply lack the experience in
> Mathematica to figure out how to get around the issue below.
>
> The data: I have a large number of points, more specifically>  15 000
> pairs of integer coordinates (x, y) in a list.
>
> The aim: Construct a weighted (undirected) graph with an edge between
> any two points (so the total number of edges is more than Binomial[15
> 000, 2] -- quite a lot). The point is that I want to find a shortest
> path between two specific vertices.
>
> The code: I have written looks like this:
>   GraphDistance[
>      (Graph[
>           #1, (* the edges *)
>           EdgeWeight ->  First[#2]]&) @@
>             Reap[
>                (Module[{},
> 	Sow[weight @@ #]; (* compute weight *)
> 	UndirectedEdge @@ # (* make edge *)
>             ]&) /@ Subsets[coords,{2}],
>       startP,
>       targetP,
>      Method -->  "Dijkstra" (* weights are>= 0 *)
>   ]
>
> The problem: The code is sooo slow - even for 5000 points :-), and
> Mathematica (for Students) aborts the computation because of
> "insufficient memory" already when I have 10000 points.
>
> Help: I have tried to look through a number of ressources on the
> internet but I have to admit that all the different pieces of advice
> on how to construct efficient code is a bit overwhelming for me as an
> inexperienced Mathematica programmer.
> I believe that it should be possible to get a reasonably efficient
> code for the above problem, but I do not know how to accomplish that.
>
> My own thoughts: First of all, the Subsets function constructs a huge
> list, and afterwards I use Map, to get two lists that are used for the
> Graph object - I believe this is where the problem is.
> I guess that, if I could produce my own subsets function where I would
> be able to compute the weight directly on each pair of points (x,y),
> and then put it directly in a SparseArray, could reduce both time, and
> memory consumption??
>
> I hope that you can maybe point me in the right direction, or have any
> specific advice for my particular graph problem :-).
>
> Thanks in advance.

With 112492500 edges this graph is unlikely to fit in the RAM of a 32 
bit machine. I do not know if Mathematica 8 on 64 bit machines will 
handle it either (nor do I know for Mathematica 9).

If you have a simple function that gives the edge weight, given a pair 
of vertices, then you can use a sparse strategy, keeping only a vector 
or two at any time rather than a full matrix.

One way go about this by explicit iteration. Keep a vector of shortest 
distances from start to all points that can be attained via n or fewer 
hops, and using Min, and distances from each to others in one hop, to 
get same for n+1 or fewer hops.

Here is pedestrian code for this purpose. I douvbt it is optimal, even 
with use of Compile to C code. (I also do not claim that it is correct-- 
caveat emptor).

I use an example consisting of (only) 1500 vertices. The weight function 
is described as:

weight[{x1_, y1_}, {x2_, y2_}] :=
  Sqrt[(N[(x1 - x2)]^2 - Abs[y2 - y1]/10.)^2]

len = 1500;
SeedRandom[1111];
coords = N[RandomInteger[{1000}, {len, 2}]];
{start, end} = RandomChoice[Range[len], 2]
weightC =
   Compile[{{p1, _Real, 1}, {p2, _Real, 1}},
    Sqrt[((p1[[1]] - p2[[1]])^2 - Abs[p1[[2]] - p2[[2]]]/10.)^2]];
v1 = weightC[coords[[start]], #] & /@ coords;
mindistC = Compile[{{d1, _Real, 1}, {coords, _Real, 2}},
    Table[Min[d1[[j]],
      Min[Table[
        d1[[k]] + weightC[coords[[k]], coords[[j]]], {k,
         Length[coords]}]]], {j, Length[d1]}],
    CompilationOptions -> {"ExpressionOptimization" -> True,
      "InlineExternalDefinitions" -> True,
      "InlineCompiledFunctions" -> True}, CompilationTarget -> "C"];
Timing[FixedPoint[mindistC[#, coords] &, v1, Length[coords]][[end]]]

Out[555]= {299, 1337}
Out[559]= {24.13, 24.}

So the min distance from vertex 299 to 1337 is 24 units.

Getting the minimal path would take more work.

Daniel Lichtblau
Wolfram Research

• References:
  • Constructing a huge graph
    • From: Martin <mfpublic@gmail.com>