Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

I am currently working with a weighted adjacency matrix for a directed graph, and it contains several 0 columns and rows. With the unaltered matrix, I am able to monitor the relations between vertices with,

TableForm[Normal @ WeightedAdjacencyMatrix[graph], 
    TableHeadings -> {a = VertexList[graph], a}]

This outputs a table with the corresponding vertex list labeling the rows and columns. I want to delete the 0 rows and columns while altering the labels to reflect the change. My matrix is currently $85\times 85$, and eliminating the necessary rows and columns reduces the size to $77\times 38$. I could theoretically go through by hand and track the eliminated entries, but that sounds way too time consuming for something that I'm sure has a simple solution. Any help is appreciated.

share|improve this question
add comment

2 Answers 2

up vote 3 down vote accepted
graph= Graph[Range@5 , {1 -> 5, 5 -> 3, 3 -> 1}, EdgeWeight-> RandomInteger[100, 3]]

shAdj[graph_] := 
  Grid[Transpose[
    Select[Transpose[
      Select[Join[{Join[{""}, VertexList[graph]]}, 
        Transpose[Join[{VertexList[graph]}, WeightedAdjacencyMatrix[graph]]]], 
       Total@Rest@# != 0 &]], Total@Rest@# != 0 &]], 
   Alignment -> Right, Dividers -> {{2 -> Red}, {2 -> Red}}];

shAdj[graph]

Mathematica graphics Mathematica graphics

share|improve this answer
add comment
nonzerorowsF = Function[{grph}, Pick[Range[VertexCount[grph]],
   Tr@Abs[#] != 0 & /@ WeightedAdjacencyMatrix[grph]]];
nonzerocolsF = Function[{grph}, Pick[Range[VertexCount[grph]],
   Tr@Abs[#] != 0 & /@ Transpose[WeightedAdjacencyMatrix[grph]]]];

example:

 options = Sequence[VertexStyle -> LightYellow,
  VertexSize -> 0.2,
  VertexLabels -> Placed["Name", {1/2, 1/2}],
  VertexLabelStyle -> Directive[16, Red, Bold, Italic],
  EdgeLabelStyle -> Directive[16, Blue, Bold],
  ImageSize -> 350, EdgeStyle -> Blue];


 ew = RandomReal[{-5, 5}, 4];
 g = Graph[{3, 4, 5, 1, 2, 6},
     {2 -> 3, 3 -> 1, 1 -> 2, 1 -> 4},
     EdgeWeight -> ew, options,
     EdgeLabels -> Thread[EdgeList[g] -> ew]]

enter image description here

rows = nonzerorowsF[g];
columns = nonzerocolsF[g];
TableForm[Normal@WeightedAdjacencyMatrix[g][[rows, columns]],
    TableHeadings -> {VertexList[g][[rows]], VertexList[g][[columns]]}]

enter image description here

share|improve this answer
add comment

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.