Re: Constructing a huge graph
- To: mathgroup at smc.vnet.net
- Subject: [mg122118] Re: Constructing a huge graph
- From: Ray Koopman <koopman at sfu.ca>
- Date: Sat, 15 Oct 2011 06:02:59 -0400 (EDT)
- Delivered-to: l-mathgroup@mail-archive0.wolfram.com
- References: <j76583$2bv$1@smc.vnet.net>
On Oct 13, 12:50 am, Martin <mfpub... at gmail.com> 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. This uses Daniel's data, weight function, and algorithm. However, it was run on an old machine using v5.2, so I've "cheated" on the problem and used a matrix of edge weights. Converting to function calls for the weights should not be too hard. n = Length@coords {start,end} = {299, 1337} {x,y} = Transpose@xy; (w = Table[Abs[(x[[j]]-x[[k]])^2 - .1 Abs[y[[j]]-y[[k]]]], {j,n},{k,n}])[[start,end]] 1500 {299,1337} 3333.6 This gets only the distance. Timing@Part[FixedPoint[Table[Min[#[[j]],Min[#+w[[j]]]],{j,n}]&, w[[start]], n], end] {78.5 Second,24.} Do we get the same distance when we swap start and end? Timing@Part[FixedPoint[Table[Min[#[[j]],Min[#+w[[j]]]],{j,n}]&, w[[end]], n], start] {75.48 Second,24.} These are slower but give the path as well as the distance. Timing@Part[Transpose@FixedPoint[Transpose@Table[ t = #[[1]] + w[[j]]; k = First@Ordering[t,1]; If[#[[1,j]] <= t[[k]], {#[[1,j]],#[[2,j]]}, {t[[k]],Append[#[[2,k]],j]}],{j,n}]&, {w[[start]],Array[{start,#}&,n]}, n], end] {106.21 Second,{24.,{299,945,216,621,659,674,1252,855, 1224,305,1162,1341,127,113,947,1337}}} Timing@Part[Transpose@FixedPoint[Transpose@Table[ t = #[[1]] + w[[j]]; k = First@Ordering[t,1]; If[#[[1,j]] <= t[[k]], {#[[1,j]],#[[2,j]]}, {t[[k]],Append[#[[2,k]],j]}],{j,n}]&, {w[[end]],Array[{end,#}&,n]}, n], start] {101.42 Second,{24.,{1337,947,113,127,1341,1162,305,1224, 855,1252,674,659,621,216,945,299}}}