#! /bin/sh
# This is a shell archive.  Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file".  To overwrite existing
# files, type "sh file -c".  You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g..  If this archive is complete, you
# will see the following message at the end:
#		"End of archive 1 (of 3)."
# Contents:  COPYING README makepackage part2
# Wrapped by skiena@sbskiena on Tue Jul 16 13:47:17 1991
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f COPYING -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"COPYING\"
else
echo shar: Extracting \"COPYING\" \(1774 characters\)
sed "s/^X//" >COPYING <<'END_OF_COPYING'
X(*
X
X	Implementing Discrete Mathematics: Combinatorics and Graph Theory
X				with Mathematica
X
X		Version 0.5   5/8/90   Beta Release
X
X		Copyright (c) 1990 by Steven S. Skiena
X
XThis package contains all the programs from the book, "Implementing
XDiscrete Mathematics: Combinatorics and Graph Theory with Mathematica"
Xby Steven S. Skiena, Addison-Wesley Publishing Co., Advanced Book Program,
X350 Bridge Parkway, Redwood City CA 94065.  ISBN 0-201-50943-1.
XFor ordering information, call 1-800-447-2226.
X
XThis package is copyright 1990 by Steven S. Skiena.  It may be copied
Xin its entirety for nonprofit purposes only.  Sale, other than for the
Xdirect cost of the media, is prohibited.  This copyright notice must
Xaccompany all copies.
X
XThese programs can be obtained on Macintosh and MS-DOS disks by sending
X$15.00 to Discrete Mathematics Disk, Wolfram Research Inc.,
XPO Box 6059, Champaign, IL 61826-9905. (217)-398-0700.
X
XThe author, Wolfram research, and Addison-Wesley Publishing Company,
XInc. make no representations, express or implied, with respond to this
Xdocumentation, of the software it describes and contains, including
Xwithout limitations, any implied warranties of mechantability or fitness
Xfor a particular purpose, all of which are expressly disclaimed.  The
Xauthor, Wolfram Research, or Addison-Wesley, their licensees,
Xdistributors and dealers shall in no event be liable for any indirect,
Xincidental, or consequential damages.
X
XThis beta release is designed to run under Version 1.2 of Mathematica.
XAny comments, bug reports, or requests to get on the Combinatorica
Xmailing list should be forwarded to:
X
X	Steven Skiena
X	Department of Computer Science
X	State University of New York
X	Stony Brook, NY 11794
X
X	skiena@sbcs.sunysb.edu
X
X	(516)-632-9026 / 8470
X
X*)
X
END_OF_COPYING
if test 1774 -ne `wc -c <COPYING`; then
    echo shar: \"COPYING\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f README -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"README\"
else
echo shar: Extracting \"README\" \(2056 characters\)
sed "s/^X//" >README <<'END_OF_README'
X
XThe Combinatorial Mathematica package contains all the programs from
Xthe book, "Implementing Discrete Mathematics: Combinatorics and Graph
XTheory with Mathematica" by Steven S. Skiena, Addison-Wesley Publishing
XCo., Advanced Book Program, 350 Bridge Parkway, Redwood City CA 94065.
XISBN 0-201-50943-1.  For ordering information, call 1-800-447-2226.
X
XCombinatorial Mathematica currently consists of one file, Combinatorica.m.
XIt is a 100K ASCII file, and so should be easy to ftp.  Since some mailers
Xchoke on files this large, we have also prepared a distribution of three
Xsmaller files, Part01, Part02, and Part03.
X
X    ------------------------------------------------------------------
X
X(0) A General Public License for Combinatorial Mathematica is in the file
X    COPYING.
X
X(1) To execute Combinatorial Mathematica, enter Mathematica and load the
X    package (<<Combinatorica.m}
X
X(2) Documentation strings for all important functions are included with
X    the package.
X
X(3) By sending your address to skiena@sbcs.sunysb.edu, you will be placed
X    on a Combinatorial Mathematica mailing list and informed about
X    new releases.
X
X(4) Part01, Part02, and Part03 are shar files.  Running each through unshar
X    or /bin/sh unpacks the files.  The main package is broken into three
X    files: part1, part2, and part3.  To reconstruct the package, the three
X    parts must be concatenated into the file Combinatorica.m.  The script
X    makepackage does this automatically.
X
X(5) A library of graphs appears in the directory graphs
X
X(6) The file, spremb.tar, contains the source to the spremb system,
X    produced by students at the University of Queensland, Australia.
X    The graph editor ged, which runs under both X-windows and SunTools,
X    reads and writes files in a format similar to Combinatorica, so it
X    provides a useful tool for working with the package.  We assume
X    no responsibility for problems in porting spremb to your environment.
X
X    For more information about spremb, contact Tony Gedge at 
X    tonyg@batserver.cs.uq.oz.au .
X
X---
END_OF_README
if test 2056 -ne `wc -c <README`; then
    echo shar: \"README\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f makepackage -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"makepackage\"
else
echo shar: Extracting \"makepackage\" \(40 characters\)
sed "s/^X//" >makepackage <<'END_OF_makepackage'
Xcat part1 part2 part3 > Combinatorica.m
END_OF_makepackage
if test 40 -ne `wc -c <makepackage`; then
    echo shar: \"makepackage\" unpacked with wrong size!
fi
chmod +x makepackage
# end of overwriting check
fi
if test -f part2 -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"part2\"
else
echo shar: Extracting \"part2\" \(24862 characters\)
sed "s/^X//" >part2 <<'END_OF_part2'
XRandomPartition[n_Integer?Positive] :=
X	Block[{mult = Table[0,{n}],j,d,m = n},
X		While[ m != 0,
X			{j,d} = NextPartitionElement[m];
X			m -= j d;
X			mult[[d]] += j;
X		];
X		Flatten[Map[(Table[#,{mult[[#]]}])&,Reverse[Range[n]]]]
X	]
X
XNextPartitionElement[n_Integer] :=
X	Block[{d=0,j,m,z=Random[] n PartitionsP[n],done=False,flag},
X		While[!done,
X			d++; m = n; j = 0; flag = False;
X			While[ !flag,
X				j++; m -=d;
X				If[ m > 0, 
X					z -= d PartitionsP[m];
X					If[ z <= 0, flag=done=True],
X					flag = True;
X					If[m==0, z -=d; If[z <= 0, done = True]]
X				];
X			];
X		];
X		{j,d}
X	]
X 
XNumberOfCompositions[n_,k_] := Binomial[ n+k-1, n ]
X 
XRandomComposition[n_Integer,k_Integer] :=
X	Map[
X		(#[[2]] - #[[1]] - 1)&,
X		Partition[Join[{0},RandomKSubset[Range[n+k-1],k-1],{n+k}], 2, 1]
X	]
X 
XCompositions[n_Integer,k_Integer] :=
X	Map[
X		(Map[(#[[2]]-#[[1]]-1)&, Partition[Join[{0},#,{n+k}],2,1] ])&,
X		KSubsets[Range[n+k-1],k-1]
X	]
X 
XNextComposition[l_List] := 
X	Block[{c=l, h=1, t},
X		While[c[[h]] == 0, h++];
X		{t,c[[h]]} = {c[[h]],0};
X		c[[1]] = t - 1;
X		c[[h+1]]++;
X		c
X	]
X
XNextComposition[l_List] :=
X	Join[{Apply[Plus,l]},Table[0,{Length[l]-1}]] /; Last[l]==Apply[Plus,l]
X 
XTableauQ[{}] = True
XTableauQ[t_List] :=
X	And [
X		Apply[ And, Map[(Apply[LessEqual,#])&,t] ],
X		Apply[ And, Map[(Apply[LessEqual,#])&,TransposeTableau[t]] ],
X		Apply[ GreaterEqual, Map[Length,t] ],
X		Apply[ GreaterEqual, Map[Length,TransposeTableau[t]] ]
X	]
X
XTransposeTableau[tb_List] :=
X	Block[{t=Select[tb,(Length[#]>=1)&],row},
X		Table[
X			row = Map[First,t];
X			t = Map[ Rest, Select[t,(Length[#]>1)&] ];
X			row,
X			{Length[First[tb]]}
X		]
X	]
X
XShapeOfTableau[t_List] := Map[Length,t]
X 
XInsertIntoTableau[e_Integer,{}] := { {e} }
X
XInsertIntoTableau[e_Integer, t1_?TableauQ] :=
X	Block[{item=e,row=0,col,t=t1},
X		While [row < Length[t],
X			row++;
X			If [Last[t[[row]]] <= item,
X				AppendTo[t[[row]],item];
X				Return[t]
X			];
X			col = Ceiling[ BinarySearch[t[[row]],item] ];
X			{item, t[[row,col]]} = {t[[row,col]], item};
X		];
X		Append[t, {item}]
X	]
X 
XConstructTableau[p_List] := ConstructTableau[p,{}]
X
XConstructTableau[{},t_List] := t
X
XConstructTableau[p_List,t_List] :=
X	ConstructTableau[Rest[p], InsertIntoTableau[First[p],t]]
X 
XDeleteFromTableau[t1_?TableauQ,r_Integer]:=
X	Block [{t=t1, col, row, item=Last[t1[[r]]]},
X		col = Length[t[[r]]];
X		If[col == 1, t = Drop[t,-1], t[[r]] = Drop[t[[r]],-1]];
X		Do [
X			While [t[[row,col]]<=item && Length[t[[row]]]>col, col++];
X			If [item < t[[row,col]], col--];
X			{item,t[[row,col]]} = {t[[row,col]],item},
X			{row,r-1,1,-1}
X		];
X		t
X	]
X 
XTableauxToPermutation[p1_?TableauQ,q1_?TableauQ] :=
X	Block[{p=p1, q=q1, row, firstrow},
X		Reverse[
X			Table[
X				firstrow = First[p];
X				row = Position[q, Max[q]] [[1,1]];
X				p = DeleteFromTableau[p,row];
X				q[[row]] = Drop[ q[[row]], -1];
X				If[ p == {},
X					First[firstrow],
X					First[Complement[firstrow,First[p]]]
X				],
X				{Apply[Plus,ShapeOfTableau[p1]]}
X			]
X		]
X	] /; ShapeOfTableau[p1] === ShapeOfTableau[q1]
X 
XLastLexicographicTableau[s_List] :=
X	Block[{c=0},
X		Map[(c+=#; Range[c-#+1,c])&, s]
X	]
X
XFirstLexicographicTableau[s_List] :=
X	TransposeTableau[ LastLexicographicTableau[ TransposePartition[s] ] ]
X 
XNextTableau[t_?TableauQ] :=
X	Block[{s,y,row,j,count=0,tj,i,n=Max[t]},
X		y = TableauToYVector[t];
X		For [j=2, (j<n)  && (y[[j]]>=y[[j-1]]), j++, ];
X		If [y[[j]] >= y[[j-1]],
X			Return[ FirstLexicographicTableau[ ShapeOfTableau[t] ] ]
X		];
X		s = ShapeOfTableau[ Table[Select[t[[i]],(#<=j)&], {i,Length[t]}] ];
X		{row} = Last[ Position[ s, s[[ Position[t,j] [[1,1]] + 1 ]] ] ];
X		s[[row]] --;
X		tj = FirstLexicographicTableau[s];
X		If[ Length[tj] < row,
X			tj = Append[tj,{j}],
X			tj[[row]] = Append[tj[[row]],j]
X		];
X		Join[
X			Table[
X				Join[tj[[i]],Select[t[[i]],(#>j)&]],
X				{i,Length[tj]}
X			],
X			Table[t[[i]],{i,Length[tj]+1,Length[t]}]
X		]
X	]
X
XTableaux[s_List] :=
X	Block[{t = LastLexicographicTableau[s]},
X		Table[ t = NextTableau[t], {NumberOfTableaux[s]} ]
X	]
X
XTableaux[n_Integer?Positive] := Apply[ Join, Map[ Tableaux, Partitions[n] ] ]
X 
XYVectorToTableau[y_List] :=
X	Block[{k},
X		Table[ Flatten[Position[y,k]], {k,Length[Union[y]]}]
X	]
X
XTableauToYVector[t_?TableauQ] :=
X	Block[{i,y=Table[1,{Length[Flatten[t]]}]},
X		Do [ Scan[ (y[[#]]=i)&, t[[i]] ], {i,2,Length[t]} ];
X		y
X	]
X 
XNumberOfTableaux[{}] := 1
XNumberOfTableaux[s_List] := 
X	Block[{row,col,transpose=TransposePartition[s]},
X		(Apply[Plus,s])! /
X		Product [
X			(transpose[[col]]-row+s[[row]]-col+1),
X			{row,Length[s]}, {col,s[[row]]}
X		]
X	]
X
XNumberOfTableaux[n_Integer] := Apply[Plus, Map[NumberOfTableaux, Partitions[n]]]
X 
XCatalanNumber[n_] := Binomial[2n,n]/(n+1)	/; (n>=0)
X 
XRandomTableau[shape_List] :=
X	Block[{i=j=n=Apply[Plus,shape],done,l,m,h=1,k,y,p=shape},
X		y= Join[TransposePartition[shape],Table[0,{n - Max[shape]}]];
X		Do[
X			{i,j} = RandomSquare[y,p]; done = False;
X			While [!done,
X				h = y[[j]] + p[[i]] - i - j;
X				If[ h != 0,
X					If[ Random[] < 0.5,
X						j = Random[Integer,{j,p[[i]]}],
X						i = Random[Integer,{i,y[[j]]}]
X					],
X					done = True
X				];
X			];
X			p[[i]]--; y[[j]]--;
X			y[[m]] = i,
X			{m,n,1,-1}
X		];
X		YVectorToTableau[y]
X	]
X
XRandomSquare[y_List,p_List] :=
X	Block[{i=Random[Integer,{1,First[y]}], j=Random[Integer,{1,First[p]}]},
X		While[(i > y[[j]]) || (j > p[[i]]), 
X			i = Random[Integer,{1,First[y]}];
X			j = Random[Integer,{1,First[p]}]
X		];
X		{i,j}
X	]
X 
XTableauClasses[p_?PermutationQ] :=
X	Block[{classes=Table[{},{Length[p]}],t={}},
X		Scan [
X			(t = InsertIntoTableau[#,t];
X			 PrependTo[classes[[Position[First[t],#] [[1,1]] ]], #])&,
X			p
X		];
X		Select[classes, (# != {})&]
X	]
X 
XLongestIncreasingSubsequence[p_?PermutationQ] :=
X	Block[{c,x,xlast},
X		c = TableauClasses[p];
X		xlast = x = First[ Last[c] ];
X		Append[
X			Reverse[
X				Map[
X					(x = First[ Intersection[#,
X					       Take[p, Position[p,x][[1,1]] ] ] ])&,
X					Reverse[ Drop[c,-1] ]
X				]
X			],
X			xlast
X		]
X	]
X
XLongestIncreasingSubsequence[{}] := {}
X 
XAddToEncroachingLists[k_Integer,{}] := {{k}}
X
XAddToEncroachingLists[k_Integer,l_List] :=
X	Append[l,{k}]  /; (k > First[Last[l]]) && (k < Last[Last[l]])
X
XAddToEncroachingLists[k_Integer,l1_List] :=
X	Block[{i,l=l1},
X		If [k <= First[Last[l]],
X			i = Ceiling[ BinarySearch[l,k,First] ];
X			PrependTo[l[[i]],k],
X			i = Ceiling[ BinarySearch[l,-k,(-Last[#])&] ];
X			AppendTo[l[[i]],k]
X		];
X		l
X	]
X 
XEncroachingListSet[l_List] := EncroachingListSet[l,{}]
XEncroachingListSet[{},e_List] := e
X
XEncroachingListSet[l_List,e_List] :=
X	EncroachingListSet[Rest[l], AddToEncroachingLists[First[l],e] ]
X 
XEdges[Graph[e_,_]] := e
X
XVertices[Graph[_,v_]] := v
X
XV[Graph[e_,_]] := Length[e]
X
XM[Graph[g_,_],___] := Apply[Plus, Map[(Apply[Plus,#])&,g] ] / 2
XM[Graph[g_,_],Directed] := Apply[Plus, Map[(Apply[Plus,#])&,g] ]
X
XChangeVertices[g_Graph,v_List] := Graph[ Edges[g], v ]
X
XChangeEdges[g_Graph,e_List] := Graph[ e, Vertices[g] ]
X 
XAddEdge[Graph[g_,v_],{x_,y_},Directed] :=
X	Block[ {gnew=g},
X		gnew[[x,y]] ++;
X		Graph[gnew,v]
X	]
X
XAddEdge[g_Graph,{x_,y_},flag_:Undirected] :=
X	AddEdge[ AddEdge[g, {x,y}, Directed], {y,x}, Directed]
X
XDeleteEdge[Graph[g_,v_],{x_,y_},Directed] :=
X	Block[ {gnew=g},
X		If [ g[[x,y]] > 1, gnew[[x,y]]--, gnew[[x,y]] = 0];
X		Graph[gnew,v]
X	]
X
XDeleteEdge[g_Graph,{x_,y_},flag_:Undirected] :=
X	DeleteEdge[ DeleteEdge[g, {x,y}, Directed], {y,x}, Directed]
X 
XAddVertex[g_Graph] := GraphUnion[g, K[1]]
X
XDeleteVertex[g_Graph,v_Integer] := InduceSubgraph[g,Complement[Range[V[g]],{v}]]
X 
XSpectrum[Graph[g_,_]] := Eigenvalues[g]
X 
XToAdjacencyLists[Graph[g_,_]] :=
X	Map[ (Flatten[ Position[ #, _?(Function[n, n!=0])] ])&, g ]
X
XFromAdjacencyLists[e_List] :=
X	Block[{blanks = Table[0,{Length[e]}] },
X		Graph[
X			Map [ (MapAt[ 1&,blanks,Partition[#,1]])&, e ],
X			CircularVertices[Length[e]]
X		]
X	]
X
XFromAdjacencyLists[e_List,v_List] := ChangeVertices[FromAdjacencyLists[e], v]
X 
XToOrderedPairs[g_Graph] := Position[ Edges[g], _?(Function[n,n != 0]) ]
X
XToUnorderedPairs[g_Graph] := Select[ ToOrderedPairs[g], (#[[1]] < #[[2]])& ]
X
XFromOrderedPairs[l_List] := 
X	Block[{n=Max[l]},
X		Graph[
X			MapAt[1&, Table[0,{n},{n}],l],
X			CircularVertices[n]
X		]
X	]
XFromOrderedPairs[{}] := Graph[{},{}]
XFromOrderedPairs[l_List,v_List] := 
X	Graph[ MapAt[1&, Table[0,{Length[v]},{Length[v]}], l], v]
X
XFromUnorderedPairs[l_List] := MakeUndirected[ FromOrderedPairs[l] ]
XFromUnorderedPairs[l_List,v_List] := MakeUndirected[ FromOrderedPairs[l,v] ]
X 
XPseudographQ[Graph[g_,_]] :=
X	Block[{i},
X		Apply[Or, Table[ g[[i,i]]!=0, {i,Length[g]} ]]
X	]
X
XUnweightedQ[Graph[g_,_]] := Apply[ And, Map[(#==0 || #==1)&, Flatten[g] ] ]
X
XSimpleQ[g_Graph] := (!PseudographQ[g]) && (UnweightedQ[g])
X
XRemoveSelfLoops[g_Graph] :=
X	Block[{i,e=Edges[g]},
X		Do [ e[[i,i]]=0, {i,V[g]} ];
X		Graph[e, Vertices[g]]
X	]	
X
XEmptyQ[g_Graph] := Edges[g] == Table[0, {V[g]}, {V[g]}]
X
XCompleteQ[g_Graph] := Edges[RemoveSelfLoops[g]] == Edges[ K[V[g]] ]
X 
XInduceSubgraph[g_Graph,{}] := Graph[{},{}]
X
XInduceSubgraph[Graph[g_,v_],s_List] :=
X	Graph[Transpose[Transpose[g[[s]]] [[s]] ],v[[s]]] /; (Length[s]<=Length[g])
X 
XContract[g_Graph,{u_Integer,v_Integer}] :=
X	Block[{o,e,i,n=V[g],newg,range=Complement[Range[V[g]],{u,v}]},
X		newg = InduceSubgraph[g,range];
X		e = Edges[newg]; o = Edges[g];
X		Graph[
X			Append[
X				Table[
X					Append[e[[i]],
X						If[o[[range[[i]],u]]>0 ||
X							o[[range[[i]],v]]>0,1,0] ],
X					{i,n-2}
X				],
X				Append[
X					Map[(If[o[[u,#]]>0||o[[v,#]]>0,1,0])&,range],
X					0
X				]
X			],
X			Join[Vertices[newg], {(Vertices[g][[u]]+Vertices[g][[v]])/2}]
X		]
X	] /; V[g] > 2
X
XContract[g_Graph,_] := K[1]	/; V[g] == 2
X 
XGraphComplement[Graph[g_,v_]] :=
X	RemoveSelfLoops[ Graph[ Map[ (Map[ (If [#==0,1,0])&, #])&, g], v ] ]
X 
XMakeUndirected[Graph[g_,v_]] :=
X	Block[{i,j,n=Length[g]},
X		Graph[ Table[If [g[[i,j]]!=0 || g[[j,i]]!=0,1,0],{i,n},{j,n}], v ]
X	]
X
XUndirectedQ[Graph[g_,_]] := (Apply[Plus,Apply[Plus,Abs[g-Transpose[g]]]] == 0)
X
XMakeSimple[g_Graph] := MakeUndirected[RemoveSelfLoops[g]]
X 
XBFS[g_Graph,start_Integer] :=
X	Block[{e,bfi=Table[0,{V[g]}],cnt=1,edges={},queue={start}},
X		e = ToAdjacencyLists[g];
X		bfi[[start]] = cnt++;
X		While[ queue != {},
X			{v,queue} = {First[queue],Rest[queue]};
X			Scan[
X				(If[ bfi[[#]] == 0,
X					bfi[[#]] = cnt++;
X					AppendTo[edges,{v,#}];
X					AppendTo[queue,#]
X				])&,
X				e[[v]]
X			];
X		];
X		{edges,bfi}
X	]
X				
XBreadthFirstTraversal[g_Graph,s_Integer,Edge] := First[BFS[g,s]]
X
XBreadthFirstTraversal[g_Graph,s_Integer,___] := InversePermutation[Last[BFS[g,s]]]
X 
XDFS[v_Integer] :=
X	( dfi[[v]] = cnt++;
X	  AppendTo[visit,v];
X	  Scan[ (If[dfi[[#]]==0,AppendTo[edges,{v,#}];DFS[#] ])&, e[[v]] ] )
X
XDepthFirstTraversal[g_Graph,start_Integer,flag_:Vertex] :=
X	Block[{visit={},e=ToAdjacencyLists[g],edges={},dfi=Table[0,{V[g]}],cnt=1},
X		DFS[start];
X		If[ flag===Edge, edges, visit]
X	]
X 
XShowGraph[g1_Graph,type_:Undirected] :=
X	Block[{g=NormalizeVertices[g1]},
X		Show[
X			Graphics[
X				Join[
X					PointsAndLines[g],
X					If[SameQ[type,Directed],Arrows[g],{}]
X				]
X			], 
X			{AspectRatio->1, PlotRange->FindPlotRange[Vertices[g]]}
X		]
X	]
X
XMinimumEdgeLength[v_List,pairs_List] :=
X	Max[ Select[
X		Chop[ Map[(Sqrt[ N[(v[[#[[1]]]]-v[[#[[2]]]]) . 
X			(v[[#[[1]]]]-v[[#[[2]]]])] ])&,pairs] ],
X		(# > 0)&
X	], 0.001 ]
X
XFindPlotRange[v_List] :=
X	Block[{xmin=Min[Map[First,v]], xmax=Max[Map[First,v]],
X			ymin=Min[Map[Last,v]], ymax=Max[Map[Last,v]]},
X		{ {xmin - 0.05 Max[1,xmax-xmin], xmax + 0.05 Max[1,xmax-xmin]},
X		  {ymin - 0.05 Max[1,ymax-ymin], ymax + 0.05 Max[1,ymax-ymin]} }
X	]
X
XPointsAndLines[Graph[e_List,v_List]] :=
X	Block[{pairs=ToOrderedPairs[Graph[e,v]]},
X		Join[
X			{PointSize[ 0.025 ]},
X			Map[Point,Chop[v]],
X			Map[(Line[Chop[ v[[#]] ]])&,pairs]
X		]
X	]
X
XArrows[Graph[e_,v_]] :=
X	Block[{pairs=ToOrderedPairs[Graph[e,v]], size, triangle},
X		size = Min[0.05, MinimumEdgeLength[v,pairs]/3];
X		triangle={ {0,0}, {-size,size/2}, {-size,-size/2} };
X		Map[
X			(Polygon[
X				TranslateVertices[
X					RotateVertices[
X						triangle,
X						Arctan[Apply[Subtract,v[[#]]]]+Pi
X					],
X					v[[ #[[2]] ]]
X				]
X			])&,
X			pairs
X		]
X	]
X 
XShowLabeledGraph[g_Graph] := ShowLabeledGraph[g,Range[V[g]]]
XShowLabeledGraph[g1_Graph,labels_List] :=
X	Block[{pairs=ToOrderedPairs[g1], g=NormalizeVertices[g1], v},
X		v = Vertices[g];
X		Show[
X			Graphics[
X				Join[
X					PointsAndLines[g],
X					Map[(Line[Chop[ v[[#]] ]])&, pairs],
X					GraphLabels[v,labels]
X				]
X			],
X			{AspectRatio->1, PlotRange->FindPlotRange[v]} 
X		]
X	]
X
XGraphLabels[v_List,l_List] :=
X	Block[{i},
X		Table[ Text[ l[[i]],v[[i]]-{0.03,0.03},{0,1} ],{i,Length[v]}]
X	]
X 
XCircularVertices[0] := {}
X
XCircularVertices[n_Integer] :=
X	Block[{i,x = N[2 Pi / n]},
X		Chop[ Table[ N[{ (Cos[x i]), (Sin[x i]) }], {i,n} ] ]
X	]
X
XCircularVertices[Graph[g_,_]] := Graph[ g, CircularVertices[ Length[g] ] ]
X 
XRankGraph[g_Graph, start_List] :=
X	Block[ {rank = Table[0,{V[g]}],edges = ToAdjacencyLists[g],v,queue,new},
X		Scan[ (rank[[#]] = 1)&, start];
X		queue = start;
X		While [queue != {},
X			v = First[queue];
X			new = Select[ edges[[v]], (rank[[#]] == 0)&];
X			Scan[ (rank[[#]] = rank[[v]]+1)&, new];
X			queue = Join[ Rest[queue], new];
X		];
X		rank
X	]
X 
XRankedEmbedding[g_Graph,start_List] := Graph[ Edges[g],RankedVertices[g,start] ]
X
XRankedVertices[g_Graph,start_List] :=
X	Block[{i,m,stages,rank,freq = Table[0,{V[g]}]},
X		rank = RankGraph[g,start];
X		stages = Distribution[ rank ];
X		Table[
X			m = ++ freq[[ rank[[i]] ]];
X			{rank[[i]], (m-1) + (1 - stages[[ rank[[i]] ]])/2 },
X			{i,V[g]}
X		]
X	]
X
XDistribution[l_List] := Distribution[l, Union[l]]
XDistribution[l_List, set_List] := Map[(Count[l,#])&, set]
X 
XEccentricity[g_Graph] := Map[ Max, AllPairsShortestPath[g] ]
XEccentricity[g_Graph,start_Integer] := Map[ Max, Last[Dijkstra[g,start]] ]
X
XDiameter[g_Graph] := Max[ Eccentricity[g] ]
X
XRadius[g_Graph] := Min[ Eccentricity[g] ]
X
XGraphCenter[g_Graph] := 
X	Block[{eccentricity = Eccentricity[g]},
X		Flatten[ Position[eccentricity, Min[eccentricity]] ]
X	]
X 
XRadialEmbedding[g_Graph,ct_Integer] :=
X	Block[{center=ct,ang,i,da,theta,n,v,positioned,done,next,e=ToAdjacencyLists[g]},
X		ang = Table[{0,2 Pi},{n=V[g]}];
X		v = Table[{0,0},{n}];
X		positioned = next = done = {center};
X		While [next != {},
X			center = First[next];
X			new = Complement[e[[center]], positioned];
X			Do [
X				da = (ang[[center,2]]-ang[[center,1]])/Length[new];
X				ang[[ new[[i]] ]] = {ang[[center,1]] + (i-1)*da,
X					ang[[center,1]] + i*da};
X				theta = Apply[Plus,ang[[ new[[i]] ]] ]/2;
X				v[[ new[[i]] ]] = v[[center]] +
X					N[{Cos[theta],Sin[theta]}],
X				{i,Length[new]}
X			];
X			next = Join[Rest[next],new];
X			positioned = Union[positioned,new];
X			AppendTo[done,center]
X		];
X		Graph[Edges[g],v]
X	]
X
XRadialEmbedding[g_Graph] := RadialEmbedding[g,First[GraphCenter[g]]];
X 
XRootedEmbedding[g_Graph,rt_Integer] :=
X	Block[{root=rt,pos,i,x,dx,new,n=V[g],v,done,next,e=ToAdjacencyLists[g]},
X		pos = Table[{-Sqrt[n],Sqrt[n]},{n}];
X		v = Table[{0,0},{n}];
X		next = done = {root};
X		While [next != {},
X			root = First[next];
X			new = Complement[e[[root]], done];
X			Do [
X				dx = (pos[[root,2]]-pos[[root,1]])/Length[new];
X				pos[[ new[[i]] ]] = {pos[[root,1]] + (i-1)*dx,
X					pos[[root,1]] + i*dx};
X				x = Apply[Plus,pos[[ new[[i]] ]] ]/2;
X				v[[ new[[i]] ]] = {x,v[[root,2]]-1},
X				{i,Length[new]}
X			];
X			next = Join[Rest[next],new];
X			done = Join[done,new]
X		];
X		Graph[Edges[g],v]
X	]
X 
XTranslateVertices[v_List,{x_,y_}] := Map[ (# + {x,y})&, v ]
XTranslateVertices[Graph[g_,v_],{x_,y_}] := Graph[g, TranslateVertices[v,{x,y}] ]
X
XDilateVertices[v_List,d_] := (d * v)
XDilateVertices[Graph[e_,v_],d_] := Graph[e, DilateVertices[v,d]]
X
XRotateVertices[v_List,t_] := 
X	Block[{d,theta},
X		Map[
X			(If[# == {0,0}, {0,0},
X				d=Sqrt[#[[1]]^2 + #[[2]]^2];
X			 	theta = t + Arctan[#];
X			 	N[{d Cos[theta], d Sin[theta]}]
X			])&,
X			v
X		]
X	]
XRotateVertices[Graph[g_,v_],t_] := Graph[g, RotateVertices[v,t]]
X
XArctan[{x_,y_}] := Arctan1[Chop[{x,y}]]
XArctan1[{0,0}] := 0
XArctan1[{x_,y_}] := ArcTan[x,y]
X
XNormalizeVertices[v_List] := 
X	Block[{v1},
X		v1 = TranslateVertices[v,{-Min[v],-Min[v]}];
X		DilateVertices[v1, 1/Max[v1,0.01]]
X	]
X
XNormalizeVertices[Graph[g_,v_]] := Graph[g, NormalizeVertices[v]]
X 
XShakeGraph[Graph[e_List,v_List], fract_:0.1] :=
X	Block[{i,d,a},
X		Graph[
X			e,
X			Table[ 
X				d = Random[Real,{0,fract}];
X				a = Random[Real,{0, 2 N[Pi]}];
X				{N[v[[i,1]] + d Cos[a]], N[v[[i,2]] + d Sin[a]]},
X				{i,Length[e]}
X			]
X		]
X	]
X 
XCalculateForce[u_Integer,g_Graph,em_List] :=
X	Block[{n=V[g],stc=0.25,gr=10.0,e=Edges[g],f={0.0,0.0},spl=1.0,v,dsquared},
X		Do [
X			dsquared = Max[0.001, Apply[Plus,(em[[u]]-em[[v]])^2] ];
X			f += (1-e[[u,v]]) (gr/dsquared) (em[[u]]-em[[v]])
X				- e[[u,v]] stc Log[dsquared/spl] (em[[u]]-em[[v]]),
X			{v,n}
X		];
X		f
X	]
X
XSpringEmbedding[g_Graph,step_:10,inc_:0.15] :=
X	Block[{new=old=Vertices[g],n=V[g],i,u,g1=MakeUndirected[g]},
X		Do [
X			Do [
X				new[[u]] = old[[u]]+inc*CalculateForce[u,g1,old],
X				{u,n}
X			];
X			old = new,
X			{i,step}
X		];
X		Graph[Edges[g],new]
X	]
X 
XReadGraph[file_] :=
X	Block[{edgelist={}, v={},x},
X		OpenRead[file];
X		While[!SameQ[(x = Read[file,Number]), EndOfFile],
X			AppendTo[v,Read[file,{Number,Number}]];
X			AppendTo[edgelist,
X				Convert[Characters[Read[file,String]]]
X			];
X		];
X		Close[file];
X		FromAdjacencyLists[edgelist,v]
X	]
X
XIsDigitQ[ch_String] :=
X	! ((ToASCII[ch] < ToASCII["0"]) || (ToASCII[ch] > ToASCII["9"]))
X
XConvert[l_List] := 
X	Block[{ch,num,edge={},i=1},
X		While[i <= Length[l],
X			If[ IsDigitQ[ l[[i]] ], 
X				num = 0;
X				While[ ((i <= Length[l]) && (IsDigitQ[l[[i]]])),
X					num = 10 num + ToASCII[l[[i++]]] - ToASCII["0"]
X				];
X				AppendTo[edge,num],
X				i++
X			];
X		];
X		edge
X	]
X 
XWriteGraph[g_Graph,file_] := 
X	Block[{edges=ToAdjacencyLists[g],v=N[NormalizeVertices[Vertices[g]]],i,x,y},
X		OpenWrite[file];
X		Do[
X			WriteString[file,"	",ToString[i]];
X			{x,y} = Chop[ v [[i]] ];
X			WriteString[file,"	",ToString[x],"	",ToString[y]];
X			Scan[
X				(WriteString[file,"	",ToString[ # ]])&,
X				edges[[i]]
X			];
X			Write[file],
X			{i,V[g]}
X		];
X		Close[file];
X	]
X 
XGraphUnion[g_Graph,h_Graph] :=
X	Block[{maxg=Max[ Map[First,Vertices[g]] ], minh=Min[ Map[First,Vertices[h]] ]},
X		FromOrderedPairs[
X			Join[ ToOrderedPairs[g], (ToOrderedPairs[h] + V[g])],
X			Join[ Vertices[g], Map[({maxg-minh+1,0}+#)&, Vertices[h] ] ]
X		]
X	]
X
XGraphUnion[1,g_Graph] := g
XGraphUnion[0,g_Graph] := EmptyGraph[0];
XGraphUnion[k_Integer,g_Graph] := GraphUnion[ GraphUnion[k-1,g], g]
X
XExpandGraph[g_Graph,n_] := GraphUnion[ g, EmptyGraph[n - V[g]] ] /; V[g] <= n
X 
XGraphIntersection[g_Graph,h_Graph] :=
X	FromOrderedPairs[
X		Intersection[ToOrderedPairs[g],ToOrderedPairs[h]],
X		Vertices[g]
X	] /; (V[g] == V[h])
X 
XGraphDifference[g1_Graph,g2_Graph] :=
X	Graph[Edges[g1] - Edges[g2], Vertices[g1]] /; V[g1]==V[g2]
X
XGraphSum[g1_Graph,g2_Graph] :=
X	Graph[Edges[g1] + Edges[g2], Vertices[g1]] /; V[g1]==V[g2]
X 
XGraphJoin[g_Graph,h_Graph] :=
X	Block[{maxg=Max[ Abs[ Map[First,Vertices[g]] ] ]},
X		FromUnorderedPairs[
X			Join[
X				ToUnorderedPairs[g],
X				ToUnorderedPairs[h] + V[g],
X				CartesianProduct[Range[V[g]],Range[V[h]]+V[g]]
X			],
X			Join[ Vertices[g], Map[({maxg+1,0}+#)&, Vertices[h]]]
X		]
X	]
X
XCartesianProduct[a_List,b_List] :=
X	Block[{i,j},
X		Flatten[ Table[{a[[i]],b[[j]]},{i,Length[a]},{j,Length[b]}], 1]
X	]
X 
XGraphProduct[g_Graph,h_Graph] :=
X	Block[{k,eg=ToOrderedPairs[g],eh=ToOrderedPairs[h],leng=V[g],lenh=V[h]},
X		FromOrderedPairs[
X			Flatten[
X				Join[
X					Table[eg+(i-1)*leng, {i,lenh}],
X					Map[ (Table[
X						{leng*(#[[1]]-1)+k, leng*(#[[2]]-1)+k},
X						{k,1,leng}
X					      ])&,
X					      eh
X					]
X				],
X				1
X			],
X			ProductVertices[Vertices[g],Vertices[h]]
X		]
X	]
X
XProductVertices[vg_,vh_] :=
X	Flatten[
X		Map[
X			(TranslateVertices[
X				DilateVertices[vg, 1/(Max[Length[vg],Length[vh]])],
X			#])&,
X			 RotateVertices[vh,Pi/2]
X		],
X		1
X	]
X 
XIncidenceMatrix[g_Graph] :=
X	Map[
X		( Join[
X			Table[0,{First[#]-1}], {1},
X			Table[0,{Last[#]-First[#]-1}], {1},
X			Table[0,{V[g]-Last[#]}]
X		] )&,
X		ToUnorderedPairs[g]
X	]
X 
XLineGraph[g_Graph] :=
X	Block[{b=IncidenceMatrix[g], edges=ToUnorderedPairs[g], v=Vertices[g]},
X		Graph[
X			b . Transpose[b] - 2 IdentityMatrix[Length[edges]],
X			Map[ ( (v[[ #[[1]] ]] + v[[ #[[2]] ]]) / 2 )&, edges]
X		]
X	]
X 
XK[0] := Graph[{},{}]
XK[1] := Graph[{{0}},{{0,0}}]
X
XK[n_Integer?Positive] := CirculantGraph[n,Range[1,Floor[(n+1)/2]]]
X
XCirculantGraph[n_Integer?Positive,l_List] :=
X	Block[{i,r},
X		r = Prepend[MapAt[1&,Table[0,{n-1}], Map[List,Join[l,n-l]]], 0];
X		Graph[ Table[RotateRight[r,i], {i,0,n-1}], CircularVertices[n] ]
X	]
X
XEmptyGraph[n_Integer?Positive] :=
X	Block[{i},
X		Graph[ Table[0,{n},{n}], Table[{0,i},{i,(1-n)/2,(n-1)/2}] ]
X	]
X 
XK[l__] :=
X	Block[{ll=List[l],t,i,x,row,stages=Length[List[l]]},
X		t = Accumulate[Plus,List[0,l]];
X		Graph[
X			Apply[
X				Join,
X				Table [
X					row = Join[
X						Table[1, {t[[i-1]]}],
X						Table[0, {t[[i]]-t[[i-1]]}],
X						Table[1, {t[[stages+1]]-t[[i]]}]
X					];
X					Table[row, {ll[[i-1]]}],
X					{i,2,stages+1}
X				]
X			
X			],
X			Apply [
X				Join,
X				Table[
X					Table[{x,i-1+(1-ll[[x]])/2},{i,ll[[x]]}],
X					{x,stages}
X				]
X			]
X		]
X	] /; TrueQ[Apply[And, Map[Positive,List[l]]]] && (Length[List[l]]>1)
X 
XTuran[n_Integer,p_Integer] :=
X	Block[{k = Floor[ n / (p-1) ], r},
X		r = n - k (p-1);
X		Apply[K, Join[ Table[k,{p-1-r}], Table[k+1,{r}] ] ]
X	] /; (n > 0 && p > 1)
X 
XCycle[n_Integer] := CirculantGraph[n,{1}]  /; n>=3
X 
XStar[n_Integer?Positive] :=
X	Block[{g},
X		g = Append [ Table[0,{n-1},{n}], Append[ Table[1,{n-1}], 0] ];
X		Graph[
X			g + Transpose[g],
X			Append[ CircularVertices[n-1], {0,0}]
X		]
X	]
X 
XWheel[n_Integer] :=
X	Block[{i,row = Join[{0,1}, Table[0,{n-4}], {1}]},
X		Graph[
X			Append[
X				Table[ Append[RotateRight[row,i-1],1], {i,n-1}],
X				Append[ Table[1,{n-1}], 0]
X			],
X			Append[ CircularVertices[n-1], {0,0} ]
X		]
X	] /; n >= 3
X 
XPath[1] := K[1]
XPath[n_Integer?Positive] :=
X	FromUnorderedPairs[ Partition[Range[n],2,1], Map[({#,0})&,Range[n]] ]
X
XGridGraph[n_Integer?Positive,m_Integer?Positive] :=
X	GraphProduct[
X		ChangeVertices[Path[n], Map[({Max[n,m]*#,0})&,Range[n]]],
X		Path[m]
X	]
X 
XHypercube[n_Integer] := Hypercube1[n]
X
XHypercube1[0] := K[1]
XHypercube1[1] := Path[2]
XHypercube1[2] := Cycle[4]
X
XHypercube1[n_Integer] := Hypercube1[n] =
X	GraphProduct[
X		RotateVertices[ Hypercube1[Floor[n/2]], 2Pi/5],
X		Hypercube1[Ceiling[n/2]]
X	]
X 
XLabeledTreeToCode[g_Graph] :=
X	Block[{e=ToAdjacencyLists[g],i,code},
X		Table [
X			{i} = First[ Position[ Map[Length,e], 1 ] ];
X			code = e[[i,1]];
X			e[[code]] = Complement[ e[[code]], {i} ];
X			e[[i]] = {};
X			code,
X			{V[g]-2}
X		]
X	]
X 
XCodeToLabeledTree[l_List] :=
X	Block[{m=Range[Length[l]+2],x,i},
X		FromUnorderedPairs[
X			Append[
X				Table[
X					x = Min[Complement[m,Drop[l,i-1]]];
X					m = Complement[m,{x}];
X					{x,l[[i]]},
X					{i,Length[l]}
X				],
X				m
X			]
X		]
X	]
X
XRandomTree[n_Integer?Positive] :=
X	RadialEmbedding[CodeToLabeledTree[ Table[Random[Integer,{1,n}],{n-2}] ], 1]
X 
XRandomGraph[n_Integer,p_] := RandomGraph[n,p,{1,1}]
X
XRandomGraph[n_Integer,p_,range_List] :=
X	Block[{i,g},
X		g = Table[ 
X			Join[
X				Table[0,{i}],
X				Table[ 
X					If[Random[Real]<p, Random[Integer,range], 0],
X					{n-i}
X				]
X			],
X			{i,n}
X		];
X		Graph[ g + Transpose[g], CircularVertices[n] ]
X	]
X 
XExactRandomGraph[n_Integer,e_Integer] :=
X	FromUnorderedPairs[
X		Map[ NthPair, Take[ RandomPermutation[n(n-1)/2], e] ],
X		CircularVertices[n]
X	]
X
XNthPair[0] := {}
XNthPair[n_Integer] :=
X	Block[{i=2},
X		While[ Binomial[i,2] < n, i++];
X		{n - Binomial[i-1,2], i}
X	]
X
XRandomVertices[n_Integer] := Table[{Random[], Random[]}, {n}]
XRandomVertices[g_Graph] := Graph[ Edges[g], RandomVertices[V[g]] ]
X 
XRandomGraph[n_Integer,p_,range_List,Directed] :=
X	RemoveSelfLoops[
X		Graph[
X			Table[If[Random[Real]<p,Random[Integer,range],0],{n},{n}],
X			CircularVertices[n]
X		]
X	]
X
XRandomGraph[n_Integer,p_,Directed] := RandomGraph[n,p,{1,1},Directed]
X 
XDegreeSequence[g_Graph] := Reverse[ Sort[ Degrees[g] ] ]
X
XDegrees[Graph[g_,_]] := Map[(Apply[Plus,#])&, g]
X
XGraphicQ[s_List] := False /; (Min[s] < 0) || (Max[s] >= Length[s])
XGraphicQ[s_List] := (First[s] == 0) /; (Length[s] == 1)
XGraphicQ[s_List] :=
X	Block[{m,sorted = Reverse[Sort[s]]},
X		m = First[sorted];
X		GraphicQ[ Join[ Take[sorted,{2,m+1}]-1, Drop[sorted,m+1] ] ]
X	]
X 
XRealizeDegreeSequence[d_List] :=
X	Block[{i,j,v,set,seq,n=Length[d],e},
X		seq = Reverse[ Sort[ Table[{d[[i]],i},{i,n}]] ];
X		FromUnorderedPairs[
X			Flatten[ Table[
X				{{k,v},seq} = {First[seq],Rest[seq]};
X				While[ !GraphicQ[
X					MapAt[
X						(# - 1)&,
X						Map[First,seq],
X						set = RandomKSubset[Table[{i},{i,n-j}],k] 
X					] ],
X				];
X				e = Map[(Prepend[seq[[#,2]],v])&,set];
X				seq = Reverse[ Sort[
X					MapAt[({#[[1]]-1,#[[2]]})&,seq,set]
X				] ];
X				e,
X				{j,Length[d]-1}
X			], 1],
X			CircularVertices[n]
X		]
X	] /; GraphicQ[d]
X
XRealizeDegreeSequence[d_List,seed_Integer] :=
X	(SeedRandom[seed]; RealizeDegreeSequence[d])
X 
XRegularQ[Graph[g_,_]] := Apply[ Equal, Map[(Apply[Plus,#])& , g] ]
X
XRegularGraph[k_Integer,n_Integer] := RealizeDegreeSequence[Table[k,{n}]]
X 
END_OF_part2
if test 24862 -ne `wc -c <part2`; then
    echo shar: \"part2\" unpacked with wrong size!
fi
# end of overwriting check
fi
echo shar: End of archive 1 \(of 3\).
cp /dev/null ark1isdone
MISSING=""
for I in 1 2 3 ; do
    if test ! -f ark${I}isdone ; then
	MISSING="${MISSING} ${I}"
    fi
done
if test "${MISSING}" = "" ; then
    echo You have unpacked all 3 archives.
    rm -f ark[1-9]isdone
else
    echo You still need to unpack the following archives:
    echo "        " ${MISSING}
fi
##  End of shell archive.
exit 0
