(* :Title: Input and Output *)

(* :Context: "GrafPack`GraphIO`" *)

(* :Authors:
	D. Andrén, P.H. Lundow (editor), K. Markström
	Department of Mathematics
	Umea University
	S-901 87 Umea
	Sweden
	Bug reports to per.hakan.lundow@math.umu.se
*)
(* :Summary:
	This package contains some standard functions of a
	combinatorial nature.
*)
(* :History:
	990602 Usage message of ShowLabelledGraph fixed.
	990831 LaTeX format added to WriteGraph.
	000919 ReadGraph[_, Graph6, All] improved. New: toGraph6, fromGraph6.
	041007 WriteGraph[_, _, LaTeX] corrected.
*)
(* :Mathematica Version: 3.0 *)
(* :Keywords: *)
(* :Limitations: *)
(* :Discussion: *)

BeginPackage["GrafPack`GraphIO`",
	{
		"GrafPack`Utilities`",
		"GrafPack`Combinatorics`", 
		"GrafPack`Basics`"
	}
]

Cabri::usage =
	"Cabri is an option for ReadGraph and WriteGraph in GrafPack."

Graph6::usage =
	"Graph6 is an option for ReadGraph and WriteGraph in GrafPack."

GroupsAndGraphs::usage =
	"GroupsAndGraphs is an option for ReadGraph and WriteGraph in GrafPack."

LaTeX::usage =
	"LaTeX is an option for WriteGraph in GrafPack."

Matrix::usage =
	"Matrix is an option for ReadGraph and WriteGraph in GrafPack."

ReadGraph::usage =
	"ReadGraph[file] reads a graph stored in Combinatorica-format from file.
	ReadGraph[file, format] reads a graph stored in the specified format from
	file. Formats include: Graph6, Matrix, Cabri, GroupsAndGraphs. If the
	Graph6 or Matrix format is used then we may replace the file with a stream
	and read several graphs or we may write ReadGraph[file, format, All] to
	receive a list of graphs."

ShowGraph::usage =
	"ShowGraph[g] displays the graph g according to its embedding."

ShowLabelledGraph::usage =
	"ShowLabelledGraph[g] displays the graph g according to its embedding
	along with the labels of the vertices. ShowLabelledGraph[g, list]
	displays the graph with the labels given in list."

WriteGraph::usage =
	"WriteGraph[file, g] writes graph g to file in Combinatorica-format.
	WriteGraph[file, g, format] writes graph g to file in the specified
	format. Formats include: Graph6, Matrix, Cabri, GroupsAndGraphs, LaTeX.
	If the Graph6 or Matrix format is used then we may replace the file
	with a stream and write several graphs. Alternatively we may write
	WriteGraph[file, g, format] when g is a list of graphs. The LaTeX
	format writes the graph as a figure-environment to a file."

Begin["`Private`"]

protected = Unprotect[]

definitions = {
	Cabri, Graph6, GroupsAndGraphs, LaTeX, Matrix, ReadGraph, ShowGraph,
	ShowLabelledGraph, WriteGraph
}

Scan[Unprotect, definitions]


ReadGraph[file_String] :=
	Module[{a, adj={}, emb={}, stream},
		stream = OpenRead[file];
		While[True,
			a = ReadLine[stream];
			If[a === EndOfFile, Break[]];
			AppendTo[adj, Drop[a, 3]];
			AppendTo[emb, Take[a, {2, 3}]];
		];
		Close[stream];
		FromAdjacencyLists[adj, emb]
	]

ReadGraph[file_String, Graph6] :=
	Module[{g, stream},
		stream = OpenRead[file];
		g = ReadGraph[stream, Graph6];
		Close[stream];
		g
	]

ReadGraph[file_String, Graph6, All] :=
	Map[fromGraph6, ReadList[file, String]]

ReadGraph[stream_InputStream, Graph6] :=
	Module[{buf},
		buf = Read[stream, String];
		If[buf === EndOfFile,Return[EndOfFile]];
		fromGraph6[buf]
	]

fromGraph6[string_String] := (* private function *)
	Module[{adj, buf, k, m, n},
		buf = ToCharacterCode[string];
		If[First[buf] == 63, Return[Graph[{}, {}]]];
		If[First[buf] == 126,
			n = Dot[Take[buf, {2, 4}] - 63, {2^12, 2^6, 2^0}];
			buf = Drop[buf, 4],
		(*Else*)
			n = First[buf] - 63;
			buf = Rest[buf];
		];
		buf = Flatten[IntegerDigits[buf - 63, 2, 6]];
		m = 0;
		adj = Table[
			Join[Take[buf,{m + 1, m = m + k}], Table[0, {n - k}]],
			{k, 0, n - 1}
		];
		FromAdjacencyMatrix[adj + Transpose[adj]]
	]

ReadGraph[file_String, Matrix] :=
	Module[{g, stream},
		stream = OpenRead[file];
		g = ReadGraph[stream, Matrix];
		Close[stream];
		g
	]

ReadGraph[file_String, Matrix, All] :=
	Module[{stream, g, h={}},
		stream = OpenRead[file];
		While[True,
			g = ReadGraph[stream, Matrix];
			If[g === EndOfFile, Break[]];
			h = AppendTo[h, g];
		];
		Close[stream];
		h
	]

ReadGraph[stream_InputStream, Matrix] :=
	Module[{a, n, adj={}},
		a = ReadLine[stream];
		If[a === EndOfFile, Return[EndOfFile]];
		n = Length[a];
		If[n == 0, Return[Graph[{}, {}]]];
		AppendTo[adj, a];
		Do[
			a = ReadLine[stream];
			AppendTo[adj, a],
			{n - 1}
		];
		FromAdjacencyMatrix[adj]
	]

ReadGraph[file_String, Cabri] :=
	Module[{a, d, stream, adj={}, emb={}},
		stream = OpenRead[file];
		Do[Read[stream, String], {4}];                 (* preamble *)
		While[True,
			If[Read[stream, Number] === EndOfFile, Break[]];
			Read[stream, Word];                        (* "d" *)
			d = Read[stream, Number];                  (* degree *)
			a = Sort[ReadList[stream, Number, d] + 1]; (* neighbours *)
			AppendTo[adj, a];
			Read[stream, Word];                        (* "c" *)
			a = ReadList[stream, Number, 2];           (* coordinates *)
			AppendTo[emb, a];
			Read[stream, String];
		];
		Close[stream];
		emb = NormalizeEmbedding[emb];
		emb = Map[{#[[1]], 1 - #[[2]]}&, emb]; (* Reflection in x-axis *)
		FromAdjacencyLists[adj, emb]
	]

ReadGraph[file_String, GroupsAndGraphs]:=
	Module[{a, i, j, n, stream, e={}, emb={}},
		stream = OpenRead[file];
		Read[stream, String];     (* &Graph *)
		Read[stream, String];     (* name   *)
		n = Read[stream, Number]; (* order  *)
		While[True,
			j = Read[stream, Number];
			If[j == 0, Break[]];
			If[j < 0, i = -j, AppendTo[e, {i, j}]];
		];
		While[True,
			a = Read[stream,String];
			If[StringMatchQ[a, "*&Coordinates*"], Break[]]
		];
		Do[
			a = ReadLine[stream];  (* {-i, xcoord, ycoord} *)
			AppendTo[emb, Rest[a]],
			{i, n}
		];
		Close[stream];
		emb = NormalizeEmbedding[emb];
		emb = Map[{#[[1]], 1 - #[[2]]}&, emb]; (* Reflection in x-axis *)
		FromEdges[e, emb]
	]
		

ShowGraph[Graph[{}, _]] := 
	Show[Graphics[Text["The null graph",{0, 0}]]]

ShowGraph[g_Graph] :=
	Module[{h=NormalizeEmbedding[g]},
		Show[
			Graphics[pointsandlines[h]],
			AspectRatio -> 1,
			PlotRange -> findplotrange[Embedding[h]]
		]
	]


ShowLabelledGraph[Graph[{}, _], ___List] :=
	Show[Graphics[Text["The null graph",{0, 0}]]]

ShowLabelledGraph[g_Graph, list_List] :=
	Module[{h=NormalizeEmbedding[g]},
		Show[
			Graphics[
				Join[
					pointsandlines[h],
					graphlabels[Embedding[h], list]
				]
			],
			AspectRatio -> 1,
			PlotRange -> findplotrange[Embedding[h]]
		]
	] /; Length[list] == Order[g]

ShowLabelledGraph[g_Graph] := ShowLabelledGraph[g, Vertices[g]]

findplotrange[emb_] := (* private function *)
	Module[{xmin, xmax, ymin, ymax},
		xmin = Min[Map[First, emb]];
		xmax = Max[Map[First, emb]];
		ymin = Min[Map[Last, emb]];
		ymax = Max[Map[Last, emb]];
		{
			{
				xmin - 0.07*Max[1, xmax - xmin],
				xmax + 0.07*Max[1, xmax - xmin]
			},
			{
				ymin - 0.07*Max[1, ymax - ymin],
				ymax + 0.07*Max[1, ymax - ymin]
			}
		}
	]

graphlabels[emb_, list_] := (* private function *)
	MapThread[
		Text[#1, #2 - {0.025, 0.025}, {0, 1}]&,
		{list, emb}
	]

pointsandlines[g:Graph[_, emb_]] := (* private function *)
	Join[
		{PointSize[0.025]},
		Map[Point, Chop[emb]],
		Map[Line[Chop[emb[[#]]]]&, ToEdges[g]]
	]


WriteGraph[file_String, g_Graph] :=
	Module[{i, emb=Chop[N[Embedding[g]]], stream},
		stream = OpenWrite[file, PageWidth -> Infinity];
		Do[
			WriteLine[stream, Join[{i}, emb[[i]], Neighbours[g, i]]],
			{i, Order[g]}
		];
		Close[stream]
	]

WriteGraph[file_String, g_Graph, Graph6] :=
	Module[{stream},
		stream = OpenWrite[file, PageWidth -> Infinity];
		WriteGraph[stream, g, Graph6];
		Close[stream]
	]

WriteGraph[file_String, g:{___Graph}, Graph6] :=
	Module[{stream},
		stream = OpenWrite[file, PageWidth -> Infinity];
		Scan[WriteGraph[stream, #, Graph6]&, g];
		Close[stream]
	]

WriteGraph[stream_OutputStream, g_Graph, Graph6]:=
	Module[{buf},
		buf = toGraph6[g];
		WriteString[stream, buf <> "\n"];
	]

toGraph6[Graph[adj_, ___]] := (* private function *)
	Module[{buf, tmp, n=Length[adj], rdx=2^Range[5,0,-1]},
		If[n == 0, Return["?"]];
		If[n <= 62,
			buf = {n + 63},
		(*Else*)
			buf = Join[
				{126},
				Map[
					(Dot[rdx, #] + 63)&,
					Partition[IntegerDigits[n, 2, 18], 6]
				]
			]
		];
		tmp = Flatten[MapThread[Take, {Rest[adj], Range[n - 1]}]];
		tmp = Join[tmp, Table[0, {Mod[-Length[tmp], 6]}]];
		tmp = Map[Dot[rdx, #]&, Partition[tmp, 6]];
		StringJoin[FromCharacterCode[Join[buf, tmp + 63]]]
	]

WriteGraph[file_String, g_Graph, Matrix] :=
	Module[{stream},
		stream = OpenWrite[file, PageWidth -> Infinity];
		WriteGraph[stream, g, Matrix];
		Close[stream]
	]

WriteGraph[file_String, g:{___Graph}, Matrix] :=
	Module[{stream},
		stream = OpenWrite[file, PageWidth -> Infinity];
		Scan[WriteGraph[stream, #, Matrix]&, g];
		Close[stream]
	]

WriteGraph[stream_OutputStream, g_Graph, Matrix] :=
	If[Order[g] == 0,
		WriteString[stream, "\n"],
	(*Else*)
		Scan[WriteLine[stream, #]&, ToAdjacencyMatrix[g]]
	]

WriteGraph[file_String, g_Graph, Cabri] :=
	Module[{i, stream, emb},
		stream=OpenWrite[file, PageWidth -> Infinity];
		WriteString[stream, "CABRI Version 3.1, Dec 1992 ", "\n"];
		WriteString[stream, "g -20", "\n"];
		WriteString[stream, "# ", ToString[Order[g]]];
		WriteString[stream, " # ", ToString[Size[g]], "\n", "\n"];
		emb = NormalizeEmbedding[Embedding[g]];
		emb = Map[{#[[1]], 1 - #[[2]]}&, emb]; (* Reflection in x-axis *)
		emb = Round[TransformEmbedding[emb, 400, 0, {10, 10}]];
		Do[
			WriteString[stream, ToString[i-1], " d ", ToString[Degree[g, i]]];
			Scan[
				WriteString[stream, " ", ToString[#-1]]&,
				Neighbours[g, i]
			];
			WriteString[stream, "\n", "     c "];
			WriteString[stream, ToString[emb[[i, 1]]], " "];
			WriteString[stream, ToString[emb[[i, 2]]], " v ", ToString[i - 1]];
			WriteString[stream, " s r s 3 o 7 4", "\n"],
			{i, Order[g]}
		];
		Close[stream]
	]

WriteGraph[file_String, g_Graph, GroupsAndGraphs] :=
	Module[{a, i, emb, stream, n=Order[g]},
		stream=OpenWrite[file, PageWidth->Infinity];
		WriteString[stream, "&Graph", "\n"];
		WriteString[stream, "Untitled", "\n"];
		WriteString[stream, ToString[n]];
		Do[
			a = Reverse[Select[Neighbours[g, i], (#>i)&]];
			If[a != {},
				WriteString[stream, "\n", ToString[-i]];
				Scan[WriteString[stream, " ", ToString[#]]&, a]
			],
			{i, n - 1}
		];
		WriteString[stream, "   0\n"];
		WriteString[stream, "&PtNames:", "\n"];
		WriteString[stream, "&Coordinates of vertices:", "\n"];
		emb = NormalizeEmbedding[Embedding[g]];
		emb = Map[{#[[1]], 1 - #[[2]]}&, emb]; (* Reflection in x-axis *)
		Do[
			WriteLine[stream, Join[{-i}, emb[[i]]]],
			{i, n}
		];
		Close[stream]
	]


WriteGraph[file_String, g_Graph, LaTeX] :=
	Module[{emb, stream},
		stream = OpenWrite[file];
		WriteString[stream, "\\begin{figure}", "\n"];
		WriteString[stream, "\t", "\\setlength{\\unitlength}{10cm}", "\n"];
		WriteString[stream, "\t", "\\begin{picture}(1, 1)", "\n"];
		emb = NormalizeEmbedding[Embedding[g]];
		Scan[
			WriteString[
				stream, 
				"\t\t",
				"\\put",
				pairtostring[#],
				"{\\circle*{0.025}}",
				"\n"
			]&,
			emb
		];
		Scan[
			WriteString[
				stream,
				"\t\t",
				"\\qbezier",
				pairtostring[#[[1]]],
				pairtostring[(#[[1]] + #[[2]])/2],
				pairtostring[#[[2]]],
				"\n"
			]&,
			Map[emb[[#]]&, ToEdges[g]]
		];
		WriteString[stream, "\t", "\\end{picture}", "\n"];
		WriteString[stream, "\\end{figure}", "\n"];
		Close[stream]
	]

pairtostring[a_] := (* private function *)
	StringReplace[ToString[N[a, 3]], {"{" -> "(", "}" -> ")"}]


Protect[Evaluate[protected]]

Scan[Protect, definitions]

End[]

EndPackage[]