(*******************************************************************
This file was generated automatically by the Mathematica front end.
It contains Initialization cells from a Notebook file, which
typically will have the same name as this file except ending in
".nb" instead of ".m".

This file is intended to be loaded into the Mathematica kernel using
the package loading commands Get or Needs.  Doing so is equivalent
to using the Evaluate Initialization Cells menu command in the front
end.

DO NOT EDIT THIS FILE.  This entire file is regenerated
automatically each time the parent Notebook file is saved in the
Mathematica front end.  Any changes you make to this file will be
overwritten.
***********************************************************************)



(*
  Version 1.0.1 - Released 21 April, 2004.
    	- minor bug fixes regarding the protection of symbols
  *)

(*
  Version 1.0 - Release 18 April, 2004
  *)

BeginPackage["LocalInteractions`Graphs`",
    {"JLink`","DiscreteMath`Combinatorica`"}
    ];
AddToClassPath[$UserBaseDirectory];
LoadClass["JLinkAssistant"]

Begin["`Private`"];
MakeUsageMessage[symbol_,
      string_]:=(symbol::usage=
        string<>" \!\(\*ButtonBox[\(More\[Ellipsis]\),ButtonStyle->\"AddOnsLink\",ButtonData:>\""<>
          ToString[symbol]<>"\"]\)");
MakeOptionMessage[option_,symbol_,
      string_]:=(option::usage=
        string<>" \!\(\*ButtonBox[\(More\[Ellipsis]\),ButtonStyle->\"AddOnsLink\",ButtonData:>\""<>
          ToString[symbol]<>"\"]\)");
End[];

Unprotect[
    BoundedDegreeNetwork,
    ConnectedCaveman,
    EqualColumnHeights,
    GraphMerge,
    HexGraph,
    Lattice,
    Moore8,
    Moore24,
    Radius,
    UniqueCenter,
    VonNeumann,
    WuenscheTree,
    Wrap
    ];



LocalInteractions`Graphs`Private`MakeUsageMessage[BoundedDegreeNetwork,
    "BoundedDegreeNetwork[V, kMin, kMax] creates a graph, if possible, having V vertices where each vertex has degree between kMin and kMax, inclusive.  Since some combinations are impossible (such as kMin==1 and kMax==1), the function will attempt to create a graph satisfying the specified constraints 50 times before aborting."]\
;

LocalInteractions`Graphs`Private`MakeUsageMessage[ConnectedCaveman,
    "ConnectedCaveman[n1,...,nN] creates a set of completely connected graphs of size n1 to nN. For each graph, a unique vertex is identified and these unique vertices are connected in a cycle. The default embedding positions the complete graphs as lobes hanging off a cycle of length N."]\
;

LocalInteractions`Graphs`Private`MakeUsageMessage[GraphMerge,
    "GraphMerge[g1, g2] creates a new graph g' by overlaying g1 and g2."];

LocalInteractions`Graphs`Private`MakeUsageMessage[HexGraph,
    "HexGraph[cols,rows] creates a hexagonal lattice having cols 'columns' and rows 'rows'. Setting the option EqualColumnHeights->False indicates that only odd numbered columns should have the specified number of rows."]\
;

LocalInteractions`Graphs`Private`MakeUsageMessage[Lattice,
    "Lattice[cols,rows, {{xoffset1,yoffset1},{xoffset2,yoffset2},...}] creates a lattice graph of the specified size where each vertex is connected to vertices located at the given offsets. By default, the lattice does not wrap at the edges. Passing the option Wrap->True will cause the lattice to wrap."]\
;

LocalInteractions`Graphs`Private`MakeUsageMessage[Moore8,
    "Moore8[W,H] creates the Moore 8 lattice of width W and height H. Passing the option Wrap->True embeds the lattice on the surface of a torus."]\
;

LocalInteractions`Graphs`Private`MakeUsageMessage[Moore24,
    "Moore24[W,H] creates the Moore 24 lattice of width W and height H. Passing the option Wrap->True embeds the lattice on the surface of a torus."]\
;

LocalInteractions`Graphs`Private`MakeUsageMessage[VonNeumann,
    "VonNeumann[W,H] creates the von Neumann lattice of width W and height H. Passing the option Wrap->True embeds the lattice on the surface of a torus."]\
;

LocalInteractions`Graphs`Private`MakeUsageMessage[WuenscheTree,
    "WuenscheTree[n1,...,nN] creates a set of random trees of size n1 to nN, linking the roots of the N trees to a unique central vertex. The default uses a radial embedding around this central vertex. Passing the option UniqueCenter->False links the roots of the N trees in a cycle."]\
;

LocalInteractions`Graphs`Private`MakeOptionMessage[
    EqualColumnHeights,
    HexGraph,
    "EqualColumnHeights is an option for the HexGraph function. If True, each column in the resulting hex graph should have the same number of rows. If False, only odd columns will have the specified number of rows. The default is True."]\
;

LocalInteractions`Graphs`Private`MakeOptionMessage[
    UniqueCenter,
    WuenscheTree,
    "UniqueCenter is an option for the WuenscheTree function. If True, there should be a unique central vertex in the graph; if False, no unique central vertex should be included. The default is True."]\
;

LocalInteractions`Graphs`Private`MakeOptionMessage[
    Radius,
    ConnectedCaveman,
    "Radius is an option for the ConnectedCaveman function. It is a real number that provides a measure of how large the center cycle should be. The default is 1.0."]\
;

LocalInteractions`Graphs`Private`MakeOptionMessage[
    Wrap,
    Lattice,
    "Wrap is an option for the Lattice function, as well as VonNeumann, Moore8, and Moore24. If True, the lattice should wrap at the edges so that it is effectively embedded on the surface of a torus. If False, the lattice should not wrap at the edges. The default is False."]\
;

Begin["`Private`"];



WuenscheTree[sizes__Integer,opts___Rule]:=
    Module[{e,newIndexes,g,l,centre,defaults},
      defaults=Options[WuenscheTree];
      centre=UniqueCenter/.{opts}/.defaults;
      If[centre===True,
        (*
          *Unique centre
          *)
        newIndexes=FoldList[Plus,1,{sizes}];
        e=CartesianProduct[{1},Rest[newIndexes]];
        l=Map[RandomTree,{sizes}];
        g=GraphUnion@@PrependTo[l,EmptyGraph[1]];
        Return[RadialEmbedding[AddEdges[g,e],1]],
        (*
          *No unique centre
          *)
        newIndexes=Rest[FoldList[Plus,1,{sizes}]];
        e=Union[
            CartesianProduct[{1},newIndexes],
            
            Partition[
              Append[newIndexes,
                newIndexes\[LeftDoubleBracket]1\[RightDoubleBracket]],2,1]
            ];
        l=Map[RandomTree,{sizes}];
        g=GraphUnion@@PrependTo[l,EmptyGraph[1]];
        Return[DeleteVertex[RadialEmbedding[AddEdges[g,e],1],1]];
        ];
      ];

WuenscheTree[grphs__Graph,opts___Rule]:=
    Module[{sizes,e,newIndexes,g,l,centre,defaults},
      defaults=Options[WuenscheTree];
      centre=UniqueCenter/.{opts}/.defaults;
      If[centre===True,
        (*
          *Unique centre
          *)
        sizes=V/@{grphs};
        newIndexes=FoldList[Plus,1,sizes];
        e=CartesianProduct[{1},Rest[newIndexes]];
        l={grphs};
        g=GraphUnion@@PrependTo[l,EmptyGraph[1]];
        Return[RadialEmbedding[AddEdges[g,e],1]],
        (*
          *No unique centre
          *)
        sizes=V/@{grphs};
        newIndexes=Rest[FoldList[Plus,1,sizes]];
        e=Union[
            CartesianProduct[{1},newIndexes],
            
            Partition[
              Append[newIndexes,
                newIndexes\[LeftDoubleBracket]1\[RightDoubleBracket]],2,1]
            ];
        l={grphs};
        g=GraphUnion@@PrependTo[l,EmptyGraph[1]];
        Return[DeleteVertex[RadialEmbedding[AddEdges[g,e],1],1]];
        ];
      ];

WuenscheTree[l_List,opts___Rule]:=WuenscheTree@@Join[l,{opts}];

Options[WuenscheTree]={ UniqueCenter\[Rule]True };



\!\(CompleteGraphRotated[n_] := Module[{g, v}, \[IndentingNewLine]g = CompleteGraph[n]; \[IndentingNewLine]Return[RotateVertices[g, \(2  Pi\)\/V[g]*\((V[g]/2 - 1.0)\)]];\[IndentingNewLine]]\)

GraphMerge[g1_,g2_]:=Module[{g,e,e1,e2,v,v1,v2},
      e1=Edges[g1];
      e2=Edges[g2]+V[g1];
      e=Map[{#}&,Join[e1,e2]];
      v1=Vertices[g1];
      v2=Vertices[g2];
      v=Map[{#}&,Join[v1,v2]];
      Return[Graph[e,v]];
      ];

\!\(\(\(ConnectedCaveman[l__Integer] := ConnectedCaveman[l, Radius \[Rule] Length[{l}]/2];\)\(\[IndentingNewLine]\)
  \)\[IndentingNewLine]
  \(ConnectedCaveman[sizes__Integer, opts___Rule] := Module[{gl, l, g, numCaves, \[Theta], v, r}, \[IndentingNewLine]r = \(Radius /. {opts}\) /. Options[ConnectedCaveman]; \[IndentingNewLine]numCaves = Length[{sizes}]; \[IndentingNewLine]l = {sizes}; \[IndentingNewLine]\[Theta] = \(2  \[Pi]\)\/numCaves; \[IndentingNewLine]gl = Table[\[IndentingNewLine]TranslateVertices[\[IndentingNewLine]RotateVertices[CompleteGraphRotated[l\[LeftDoubleBracket]i\[RightDoubleBracket]], \[Theta]\ *i], \[IndentingNewLine]{r*Cos[\[Theta]*i], r*Sin[\[Theta]*i]}\[IndentingNewLine]], {i, 1, numCaves}\[IndentingNewLine]]; \[IndentingNewLine]v = Most[FoldList[Plus, 1, l]]; \[IndentingNewLine]AppendTo[v, v\[LeftDoubleBracket]1\[RightDoubleBracket]]; \[IndentingNewLine]v = Table[{v\[LeftDoubleBracket]i\[RightDoubleBracket], v\[LeftDoubleBracket]i + 1\[RightDoubleBracket]}, {i, 1, Length[v] - 1}]; \[IndentingNewLine]g = Fold[GraphMerge, gl\[LeftDoubleBracket]1\[RightDoubleBracket], Rest[gl]]; \[IndentingNewLine]g = AddEdges[g, v]; \[IndentingNewLine]Return[g];\[IndentingNewLine]];\)\)

ConnectedCaveman[l_?(VectorQ[#,IntegerQ]&),opts___Rule]:=
    ConnectedCaveman@@Join[l,{opts}];

Options[ConnectedCaveman]={Radius\[Rule]1.0};



\!\(\(CreateHexRow[numCols_, row_] := Module[{l, y, C, S}, \[IndentingNewLine]y = 2*row*Sin[\[Pi]\/3]; \[IndentingNewLine]C = Cos[\[Pi]\/3]; \[IndentingNewLine]S = Sin[\[Pi]\/3]; \[IndentingNewLine]l = Table[\[IndentingNewLine]{{{x, y}}, {{x + C, y - S}}, {{x + 1 + C, y - S}}, {{x + 1 + 2  C, y}}}, {x, 0, 3*numCols - 1, 3}\[IndentingNewLine]]; \[IndentingNewLine]l = Flatten[l, 1]; \[IndentingNewLine]Which[\[IndentingNewLine]numCols \[Equal] 1, \[IndentingNewLine]Return[Take[l, 4]], \[IndentingNewLine]\[IndentingNewLine]EvenQ[numCols] \[Equal] True \[And] row \[Equal] 1, \[IndentingNewLine]Return[Take[l, \((numCols\/2)\)*4 + 1]], \[IndentingNewLine]\[IndentingNewLine]EvenQ[numCols] \[Equal] False \[And] row \[Equal] 1, \[IndentingNewLine]Return[Take[l, \((\(numCols - 1\)\/2 + 1)\)*4]], \[IndentingNewLine]\[IndentingNewLine]EvenQ[numCols] \[Equal] True, \[IndentingNewLine]Return[Take[l, \((numCols\/2)\)*4 + 2]], \[IndentingNewLine]\[IndentingNewLine]EvenQ[numCols] \[Equal] False, \[IndentingNewLine]Return[Take[l, \((\(numCols - 1\)\/2 + 1)\)*4]]\[IndentingNewLine]]\[IndentingNewLine]];\)\)

\!\(\(HexGraph[cols_, rows_, opts___Rule] := Module[{v, vert, l, e, p, i, equalHeights}, \[IndentingNewLine]\[IndentingNewLine]equalHeights = \(EqualColumnHeights /. {opts}\) /. Options[HexGraph]; \[IndentingNewLine]\[IndentingNewLine]If[equalHeights \[Equal] True, \[IndentingNewLine]v = Union @@ Table[\[IndentingNewLine]CreateHexRow[cols, i], {i, 1, rows + 1}\[IndentingNewLine]]; \[IndentingNewLine]If[EvenQ[cols] \[Equal] False, \[IndentingNewLine]v = Most[v]\[IndentingNewLine]]; \[IndentingNewLine]v = Drop[v, {rows + 1}];\[IndentingNewLine]]; \[IndentingNewLine]\[IndentingNewLine]If[equalHeights \[Equal] False, \[IndentingNewLine]v = Union @@ Table[\[IndentingNewLine]CreateHexRow[cols, i], {i, 1, rows + 1}\[IndentingNewLine]]; \[IndentingNewLine]v = Select[v, #\[LeftDoubleBracket]1, 2\[RightDoubleBracket] <= \((2*rows + 1)\)*Sin[\[Pi]\/3] &]; \[IndentingNewLine]If[EvenQ[cols] \[Equal] True, \[IndentingNewLine]v = Most[v]\[IndentingNewLine]];\[IndentingNewLine]]; \[IndentingNewLine]\[IndentingNewLine]l = {}; \[IndentingNewLine]For[i = 1, i < Length[v], \(i++\), \[IndentingNewLine]vert = v\[LeftDoubleBracket]i\[RightDoubleBracket]; \[IndentingNewLine]p = Flatten[Position[v, vert + {{Cos[\[Pi]\/3], Sin[\[Pi]\/3]}}, 1, 1]]; \[IndentingNewLine]If[p \[NotEqual] {}, AppendTo[l, {{i, p\[LeftDoubleBracket]1\[RightDoubleBracket]}}]]; \[IndentingNewLine]p = Flatten[Position[v, vert + {{Cos[\[Pi]\/3], \(-Sin[\[Pi]\/3]\)}}, 1, 1]]; \[IndentingNewLine]If[p \[NotEqual] {}, AppendTo[l, {{i, p\[LeftDoubleBracket]1\[RightDoubleBracket]}}]]; \[IndentingNewLine]p = Flatten[Position[v, vert + {{1, 0}}, 1, 1]]; \[IndentingNewLine]If[p \[NotEqual] {}, AppendTo[l, {{i, p\[LeftDoubleBracket]1\[RightDoubleBracket]}}]];\[IndentingNewLine]]; \[IndentingNewLine]\[IndentingNewLine]Return[Graph[l, v]];\[IndentingNewLine]];\)\)

Options[HexGraph]={EqualColumnHeights\[Rule]True};



RealizeableDegreeSequence[n_,kmin_,kmax_,opts___Rule]:=
    Module[{l,c,maxItr,defaults},
      l={1};
      c=0;
      defaults=Options[BoundedDegreeNetwork];
      maxItr=MaxIterations/.{opts}/.defaults;
      While[GraphicQ[l]\[Equal]False\[And]c<maxItr,
        l=Table[Random[Integer,{kmin,kmax}],{n}];
        c++;
        ];
      If[GraphicQ[l]\[Equal]False,
        Message[BoundedDegreeNetwork::failure,maxItr];
        Return[],
        Return[l]
        ]
      ];

BoundedDegreeNetwork::failure="No suitable degree sequence satisfying the specified constraints was found after `` iterations.";\


BoundedDegreeNetwork[n_,kmin_,kmax_,opts___Rule]:=Module[{l},
      l=RealizeableDegreeSequence[n,kmin,kmax,opts];
      If[l=!=Null,
        Return[RealizeDegreeSequence[l]]
        ]
      ];

Options[BoundedDegreeNetwork]={MaxIterations\[Rule]50};



Lattice[cols_,rows_,offsets_,opts___]:=Module[{shouldWrap},
      defaults=Options[Lattice];
      shouldWrap=Wrap/.{opts}/.defaults;
      Return[
        JLinkAssistant`latticeConstructor[shouldWrap,cols,rows,offsets]
        ]
      ];

Options[Lattice]={Wrap\[Rule]False};



VonNeumann[cols_,rows_,opts___]:=
    
    Lattice[cols,rows,{{1,0},{0,1},{-1,0},{0,-1}},opts];



Moore8[cols_,rows_,opts___]:=
    Lattice[cols,rows,
      {{1,0},{0,1},{-1,0},{0,-1},
        {1,1},{1,-1},{-1,1},{-1,-1}},opts];



Moore24[cols_,rows_,opts___]:=
    
    Lattice[cols,
      rows,{{-2,-2},{-2,-1},{-2,0},{-2,1},{-2,2},{-1,-2},{-1,-1},{-1,0},{-1,
          1},{-1,2},{0,-2},{0,-1},{0,1},{0,2},{1,-2},{1,-1},{1,0},{1,1},{1,
          2},{2,-2},{2,-1},{2,0},{2,1},{2,2}},opts];



End[];
Protect[
    BoundedDegreeNetwork,
    ConnectedCaveman,
    EqualColumnHeights,
    GraphMerge,
    HexGraph,
    Lattice,
    Moore8,
    Moore24,
    Radius,
    UniqueCenter,
    VonNeumann,
    WuenscheTree,
    Wrap
    ];
EndPackage[];