Given a undirected graph $G=(V,E)$, I am trying to generate a related matrix $M$, where columns are indexed by $E(G)$ and rows are indexed by all odd subsets of $V(G)$. I can finish this task using the following code:

g is a given graph;

I'm not so good at Mathematica, but it's quite strange to me while Map is nested in a Do loop. Is there a neat way to generate the corresponding matrix? By the way, I eliminate all the zero rows in the matrix in my original code.

Any comments or suggestions are most welcome!


I have to admit that this post goes much further than I expected. Thank you to those who has contributed to this question. Your brilliant ideas on how to write the code make the question much more interesting.

It's a hard choice to decide which answer to choose. But to be honest, @kguler 's solution is what I was expecting. His code accomplishes my idea on how to construct the matrix in the most elegant and readable way (from my perspective). As to the efficiency of his code, it is my idea on how tho construct the matrix that is pulling his back, not his code. And @paw found the defect in my programming idea and speeded it up a lot in his code, which is another beautiful and elegant program to construct the matrix. After his first program, @ubpdqn gave another element program mainly based on @paw 's idea, but slightly faster and more readable (to me) than @paw 's. Besides, @halmir presented us with a new idea on how to construct the matrix, which is based on the observation of the the relations between the incidence matrix and the desired matrix. Even though we have so much perfect solutions, as I have mentioned at the beginning, @kugler 's solution is what I was expecting. So I decided to adopt his solution as the final answer. But sincere thank you to all who contributed.


Although documentation does not show this particular usage pattern, odd-length subsets can be obtained using the second argument of Subsets:

oddsubsets = Subsets[VertexList[#], {3, ∞, 2}] &;
(* excluded subsets of length 1; change 3 to 1 if you need all odd-sized subsets *)

eVsubsetsM = Function[{g},  Outer[Boole[MemberQ[EdgeList[Subgraph[g, #1]], #2]]&, 
   oddsubsets@g, EdgeList@g, 1]];

Usage example:

g = RandomGraph[{7, 10}, ImageSize -> 400];
ap = eVsubsetsM[g] // ArrayPlot[#, ImageSize -> 50] &;
Row[{g, ap}]

enter image description here


enter image description here

| improve this answer | |
  • 1
    $\begingroup$ +1 for semi-undocumented Subsets parameter! It it shown in the error message: "Subsets::nninfseq: ... and third element (optional) is a nonzero integer ..." but I never noticed that until now. $\endgroup$ – Mr.Wizard Oct 3 '14 at 15:30

Here is a version that is slightly faster then all the other answers so far:

  g = RandomGraph[{9, 12}]

enter image description here

  nZ = Flatten[
      Position[EdgeList[g], #] & /@ EdgeList[Subgraph[g, #]]] & /@ 
    Select[Subsets[VertexList[g]], Length@# > 1 && OddQ@Length@# &];
  nZ = Flatten@Table[{n, #} -> 1 & /@ nZ[[n]], {n, 1, Length@nZ}];


(*paw:*)      0.028285  
(*Han Xiao:*) 0.034661  
(*ubpdqn:*)   0.083890
(*kguler:*)   0.164534
| improve this answer | |

This is ugly cf @kguler and other answers

fun[gr_] := 
 Module[{el, vl, sub, 
   f = Function[{x, y}, 
     1 - Unitize[Norm[# - Sort@x] & /@ (Sort /@ List @@@ y)]], subg, 
  el = EdgeList[gr];
  vl = VertexList[gr];
  sub = Subsets[vl, {1,Infinity,2}];
  subg = List @@@ EdgeList[Subgraph[gr, #]] & /@ sub;
  res = If[# == {}, ConstantArray[0, {Length@el}], 
      Total@Map[Function[x, f[x, el]], #]] & /@ subg;
  TableForm[res, TableHeadings -> {sub, el}]

e.g g=

enter image description here

fun[g] yields:

enter image description here

| improve this answer | |

Here's another variation using IncidenceMatrix:

relation[g_] :=
  Block[{im, sub, vlist},
   im = IncidenceMatrix[g];
   sub = Subsets[Range[VertexCount[g]], {3, Infinity, 2}];
   UnitStep[Total[im[[#]]] & /@ sub - 2]


g = RandomGraph[{5, 5}]

enter image description here

 TableHeadings -> {Subsets[VertexList[g], {3, Infinity, 2}], 

enter image description here

| improve this answer | |
  • $\begingroup$ very nice approach +1:) $\endgroup$ – ubpdqn Oct 3 '14 at 2:48

I post this as another variant but clearly inspired by other answers but different from my original:

sa[g_] := With[{el = EdgeList[g], vl = VertexList[g]},
  sub = Subsets[vl, {3, Infinity, 2}];
      j_} /; (Length@Intersection[sub[[i]], List @@ el[[j]]] == 2) :> 
    1, {Length@sub, Length@el}]]

Testing: test graph with adjacency matrix:

{{0, 1, 1, 0, 0}, {1, 0, 0, 1, 1}, {1, 0, 0, 0, 0}, {0, 1, 0, 0, 
  1}, {0, 1, 0, 1, 0}}

enter image description here


enter image description here

| improve this answer | |

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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