Re: creating adjacency matrices
- To: mathgroup at smc.vnet.net
- Subject: [mg36587] Re: creating adjacency matrices
- From: Tom Burton <tburton at brahea.com>
- Date: Fri, 13 Sep 2002 01:13:57 -0400 (EDT)
- Sender: owner-wri-mathgroup at wolfram.com
Hello,
On 9/11/02 10:43 AM, in article alnvl6$7pn$1 at smc.vnet.net, "Moliterno,
Thomas" <TMoliter at gsm.uci.edu> wrote:
> I need to create an adjacency matrix from my data, which is currently in
> the form of a .txt file and is basically a two column incidence list.
> For example:
>
> 1 A
> 1 B
> 2 B
> 3 C
> . .
> . .
> . .
> m n
Past the following notebook into Mathematica.
Tom Burton
Notebook[{
Cell[CellGroupData[{
Cell["Preparing an adjacency matrix",
"Section"],
Cell["\<\
This notebook was prepared with the default cell
output \
format type set to TraditionalForm. Then the output cells were
\
removed to saved space. I recommend that execute this entire notebook
\
before editing it.\
\>",
"Text"],
Cell[CellGroupData[{
Cell["Introduction",
"Subsection"],
Cell["\<\
Given the list of pairs of actors and events, it
appears \
that most of the work is in preparing the associated list of
\
undirected edges. So if you want only an adjacency matrix, it is \
perhaps
more trouble that it's worth to prepare the associated graph. \
But the
graph is nice, so I am showing both methods. \
\>", "Text"]
}, Open
]],
Cell[CellGroupData[{
Cell["The structure of a graph",
"Subsection"],
Cell["\<\
We need to investigate the structure of a graph so
we can \
make our own graph.\
\>", "Text"],
Cell[BoxData[
\(<<
DiscreteMath`Combinatorica`\)], "Input"],
Cell["Start with the simplest
graph:", "Text"],
Cell[BoxData[
\(aa = CompleteGraph[2]\)],
"Input"],
Cell[BoxData[
\(InputForm[aa]\)], "Input"],
Cell["\<\
It
appears to be a list of undirected edges followed by a \
list of vertices,
each element of which is wrapped in an extra pair \
of braces. Let's try
it:\
\>", "Text"],
Cell[BoxData[
\(bb =
Graph[{{{1, 2}}},
{{{\(-1. \), 0}}, {{1. , 0}}}]\)], "Input"],
Cell[BoxData[
\(ToAdjacencyMatrix[aa]\)], "Input"],
Cell[BoxData[
\(ToAdjacencyMatrix[bb]\)], "Input"]
}, Open
]],
Cell[CellGroupData[{
Cell["Example of a list of actor-event pairs",
"Subsection"],
Cell[BoxData[
\(data = {{1, "\<B\>"}, {4, "\<A\>"}, {3,
"\<C\>"}, {1, "\<A\>"}, \
{1, "\<D\>"}, {3, "\<B\>"}, {2, "\<C\>"}, {2,
"\<B\>"}}\)], "Input"],
Cell["\<\
Get the number of actors, which will be
the dimension of \
the matrix and the number of vertices in the graph.\
\>",
"Text"],
Cell[BoxData[
\(d = Max[data[\([All, 1]\)]]\)], "Input"]
},
Open ]],
Cell[CellGroupData[{
Cell["Getting the list of edges",
"Subsection"],
Cell[TextData[{
"Given the list of actors and actions,
this is most of the work. \
I'll do it in baby steps, as I would like to see
were I new to ",
StyleBox["Mathematica",
FontSlant->"Italic"],
". It
could be done more directly."
}], "Text"],
Cell["Put events first.",
"Text"],
Cell[BoxData[
\(data2 = Reverse /@ data\)],
"Input"],
Cell["Group by event, with increasing actors within each event.",
\
"Text"],
Cell[BoxData[
\(data3 = Sort[data2]\)],
"Input"],
Cell[BoxData[
\(data4 = Split[data3, First[#1] == First[#2]
&]\)], "Input"],
Cell["Remove isolated pairs.", "Text"],
Cell[BoxData[
\(data5 = DeleteCases[data4, {{_, _}}]\)], "Input"],
Cell["Drop the
actions.", "Text"],
Cell[BoxData[
\(data6 =
data5\[LeftDoubleBracket]All, All,
2\[RightDoubleBracket]\)],
"Input"],
Cell["\<\
Edges are all subsets of connected vertices taken two
at a \
time:\
\>", "Text"],
Cell[BoxData[
\(data7 = \(KSubsets[#, \ 2]
&\) /@ data6\)], "Input"],
Cell["Collect edges into one list",
"Text"],
Cell[BoxData[
\(data8 = Flatten[data7, 1]\)],
"Input"],
Cell["and remove duplicates", "Text"],
Cell[BoxData[
\(onedir = Union[data8]\)], "Input"]
}, Open
]],
Cell[CellGroupData[{
Cell["Adjacency matrix via a list of edges using
MapAt", \
"Subsection"],
Cell["Convert to directed edges",
"Text"],
Cell[BoxData[
\(bothdir = Join[onedir, Reverse /@ onedir]\)],
"Input"],
Cell["\<\
and finally, construct the adjacency matrix, putting
1's \
into elements corresponding to directed edges:\
\>",
"Text"],
Cell[BoxData[
\(emptymat = Table[0, {d}, {d}]\)],
"Input"],
Cell[BoxData[
\(adjmat = MapAt[1 &, emptymat, bothdir]\)],
"Input"]
}, Open ]],
Cell[CellGroupData[{
Cell["Adjacency matric via
ToAdjacencyMatrix", "Subsection"],
Cell["Construct a set of vertices for
display", "Text"],
Cell[BoxData[
\(verts =
Table[{Cos[2 \[Pi]\
j/d], Sin[2 \[Pi]\ j/d]}, {j,
d}]\)],
"Input"],
Cell["\<\
Prepare graph, adding extra braces and making the
\
coordinates of the vertices real numbers (this appears to be
\
necessary)\
\>", "Text"],
Cell[BoxData[
\(g = Graph[List /@ onedir,
N[List /@ verts]]\)], "Input"],
Cell["Check our handiwork:",
"Text"],
Cell[BoxData[
\(InputForm[g]\)], "Input"],
Cell[BoxData[
\(\(ShowGraph[g];\)\)], "Input"],
Cell[BoxData[
\(ToAdjacencyMatrix[g]\)], "Input"]
}, Open ]]
}, Open
]]
},
FrontEndVersion->"4.2 for Macintosh",
ScreenRectangle->{{43, 1152},
{0, 746}},
WindowSize->{565, 624},
WindowMargins->{{243, Automatic}, {48,
Automatic}}
]