Mathematica 9 is now available
Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
2002
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*November
*December
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 2002

[Date Index] [Thread Index] [Author Index]

Search the Archive

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}}
]




  • Prev by Date: Re: Empirical CDF and InterpolatingFunction
  • Next by Date: RE: Empirical CDF and InterpolatingFunction
  • Previous by thread: Re: creating adjacency matrices
  • Next by thread: Empirical CDF and InterpolatingFunction