(* :Title: Anneal
*)
(* :Author:
Jeffrey A. Stern
*)
(* :Summary:
Anneal: A Simulated Annealing Algorithm for Combinatorica
Graphs in Mathematica
This package includes a single procedure, Anneal, which minimizes the
total length of all edges in a graph, and returns a new graph. The
locations of all the points are the same, just exchanged to minimize
the total length of the edges connecting them. Thus, a circular graph
will stay circular, etc.
This package depends upon having Steven Skiena's package,
Combinatorica, also loaded prior to its use. Combinatorica2.0 is
available by anonymous ftp from sbcs.sunysb.edu in the
/pub/Combinatorica directory, and is in the Packages/DiscreteMath
subdirectory of all Mathematicas 2.0 and later. He has also written a
book on this package: "Implementing Discrete Mathematics: Combinatorics
and Graph Theory with Mathematica", through Addison- Wesley, ISBN 0-
201- 50943- 1. (The author is greatly indebted to Skiena's work
in Combinatorica and Mathematica).
Thus, Anneal only works on graphs. Instead of working with the
Edges of a graph directly, it first converts to an AdjacencyList (from
Combinatorica) form of the graph, in order to save time with large but
sparce graphs. The algorithm by nature is very slow, since it is
procedural, not one of Mathematica's strengths. However, it may be
also used as a teaching tool, or as an example to modify for other
purposes, or as a model for programming compiled external code. I
adapted the general algorithm from "Numerical Recipes in C: the art of
scientific computing", by William H. Press et. al., Cambridge U.
Press.
Any comments, bug reports, etc. should be forwarded to:
Jeff Stern
Program in Social Networks
Social Science Tower
University of California
Irvine, CA 92717
jstern@aris.ss.uci.edu
(714)856-4021
*)
(* :Context: DiscreteMath`Anneal`
*)
(* :Package Version: .1 (2/1/93 Beta Release)
*)
(* :Copyright: Copyright 1993 by Jeffrey A. Stern
This package may be copied in its entirety for nonprofit purposes only.
Sale, other than for the direct cost of the media, is prohibited. This
copyright notice must accompany all copies.
The author, makes no representations, express or implied, with respond to this
documentation, of the software it describes and contains, including
without limitations, any implied warranties of mechantability or fitness
for a particular purpose, all of which are expressly disclaimed. The
author shall in no event be liable for any indirect, incidental, or
consequential damages.
*)
(* :History:
Version .1 by Jeffrey A. Stern, 1993.
*)
(* :Keywords:
adjacency, anneal, graph, isomorphism, automorphism, network,
embedding
*)
(* :Mathematica Version: 2.0
*)
BeginPackage["DiscreteMath`Anneal`", {"DiscreteMath`Combinatorica`"}]
Anneal::usage =
"Anneal[g] exchanges vertices' locations with each other repeatedly
to find a global minimum for the total length of all edges in graph g.
It returns a new graph. Example: h= Anneal[g]."
Begin["`Private`"]
(* Alen computes the distance between any two points *)
(* (x1,y1), (x2, y2) where a, b, c, d are x1, x2, y1, y2 *)
(* respectively *)
Alen= Compile[{a,b,c,d}, Sqrt[(b-a)^2 + (d-c)^2] ];
Anneal[G_Graph]:= Module[{npoints, nover, ad, verts,
nlimit, p, t, i, nsucc, n, de, ans, TFACTR=0.9, tG, s,
oldp, minp, tolerance, iterations},
e= Edges[G];
v= Vertices[G];
ad= ToAdjacencyLists[G];
adu= ToAdjacencyLists[MakeUndirected[G]];
verts= v;
iterations= 100; (* Set this to whatever your little heart desires *)
npoints= Length[verts];
nover= iterations npoints +1;
nlimit= 10 npoints -1;
p= 0.0;
t= 0.5;
n1= {};
n2= {};
tolerance= iterations - 1;
(* TOLERANCE: This is set for 99 (actually 100 because of the loop
structure below) iterations, to be a pure Simulated Annealing
algorithm. But I often set it for 9. That is, if we should get 10
iterations in a row with the same path length, I am going to cut it
off there, and assume we've reached the global minimum, instead of
waiting for it to go all the way through 100 iterations. This is NOT
a standard part of the pure Simulated Annealing algorithm, and
actually probably defeats the purpose of getting back out of those
local minima. BUT, I am impatient, and computer time can be
expensive. If you want the algorithm to work, guaranteed, through the
full 100 iterations, then just leave it set to (iterations -1)
*)
(* CALCULATE INITAL TOTAL LENGTH OF ALL EDGES *)
For[i=1, i ToString[AX]];
Print["AY " <> ToString[AY]];
Print["LAX " <> ToString[LAX]];
Print["LAY " <> ToString[LAY]]; *)
(* CALC GAIN (REDUCTION IN LENGTH) FROM DISCONNECTING n1 *)
(* FROM AX *)
For[i=1, i nlimit, Break[] ];
]; (* FOR k *)
Print[" " <>
ToString[j] <> " " <>
ToString[p] <> " " <>
ToString[nsucc]];
t *= TFACTR;
If[p==minp, ++Shorter,
If[p tolerance)), Break[] ];
]; (* FOR j *)
(* MAKE NEW GRAPH WITH NEW VERTICES AND SEND BACK *)
tG= Graph[e, verts];
Print["Final Path Length"];
Print[ToString[p]];
Print["DONE."];
tG]; (* ANNEAL *)
End[]
EndPackage[]