0
\$\begingroup\$

I made Mathematica demonstration of Gremban Expansion for Signed Networks and Community–Faction Detection based on the 2 algorithms provided in arXiv:2509.14193.

(* Algorithm 1: Detecting communities and factions via the Gremban Laplacian *)
(* Implementation of the algorithm from "Gremban expansion for analyzing signed networks" *)

(* Function to create the Gremban expansion of a signed graph *)
GrembanExpansion[signedAdjacency_] := Module[{n, aPlus, aMinus, grembanMatrix},
  n = Length[signedAdjacency];

  (* Split signed adjacency into positive and negative parts *)
  aPlus = Map[Max[#, 0] &, signedAdjacency, {2}];
  aMinus = Map[Max[-#, 0] &, signedAdjacency, {2}];

  (* Create the Gremban adjacency matrix (2n x 2n) *)
  grembanMatrix = ArrayFlatten[{{aPlus, aMinus}, {aMinus, aPlus}}];

  grembanMatrix
];

(* Function to compute the Gremban Laplacian *)
GrembanLaplacian[signedAdjacency_] := Module[{grembanAdj, degrees, laplacian},
  grembanAdj = GrembanExpansion[signedAdjacency];
  degrees = DiagonalMatrix[Total[grembanAdj, {2}]];
  laplacian = degrees - grembanAdj;

  laplacian
];

(* Projection operators for symmetric and antisymmetric parts *)
SymmetricProjection[n_] := (1/Sqrt[2]) * ArrayFlatten[{{IdentityMatrix[n], IdentityMatrix[n]}}];
AntisymmetricProjection[n_] := (1/Sqrt[2]) * ArrayFlatten[{{IdentityMatrix[n], -IdentityMatrix[n]}}];

(* Algorithm 1: Community-Faction Detection *)
CommunityFactionDetection[signedAdjacency_] := Module[{
  n, grembanLaplacian, eigenSystem, eigenValues, eigenVectors,
  sortedIndices, fiedlerVector, signVector,
  piS, piA, cVector, fVector, cNorm, fNorm, result
  },

  n = Length[signedAdjacency];

  (* Step 1: Compute the Gremban Laplacian *)
  grembanLaplacian = GrembanLaplacian[signedAdjacency];

  (* Step 2: Compute the Fiedler eigenvector (second smallest eigenvalue) *)
  eigenSystem = Eigensystem[grembanLaplacian];
  eigenValues = eigenSystem[[1]];
  eigenVectors = eigenSystem[[2]];

  (* Sort by eigenvalue (ascending) and take second smallest (Fiedler) *)
  sortedIndices = Ordering[eigenValues];
  fiedlerVector = eigenVectors[[sortedIndices[[2]]]]; (* Second smallest eigenvalue *)

  (* Step 3: Compute sign vector *)
  signVector = Sign[fiedlerVector];

  (* Step 4: Compute projections *)
  piS = SymmetricProjection[n];
  piA = AntisymmetricProjection[n];

  cVector = piS . signVector;
  fVector = piA . signVector;

  (* Step 5: Determine dominant structure by counting non-zero entries *)
  (* Use ||·||₀ norm (number of non-zero entries) *)
  cNorm = Count[N[cVector], x_ /; Abs[x] > 0.00001]; (* Small tolerance for numerical precision *)
  fNorm = Count[N[fVector], x_ /; Abs[x] > 0.00001];

  (* Step 6: Return result *)
  result = <|
    "GrembanLaplacian" -> grembanLaplacian,
    "FiedlerEigenvalue" -> eigenValues[[sortedIndices[[2]]]],
    "FiedlerVector" -> fiedlerVector,
    "SignVector" -> signVector,
    "SymmetricProjection" -> cVector,
    "AntisymmetricProjection" -> fVector,
    "SymmetricNorm" -> cNorm,
    "AntisymmetricNorm" -> fNorm
  |>;

  If[cNorm > fNorm,
    result["DominantStructure"] = "Community";
    result["Partition"] = cVector,
    If[fNorm > cNorm,
      result["DominantStructure"] = "Faction";
      result["Partition"] = fVector,
      result["DominantStructure"] = "Mixed";
      result["Partition"] = "Multiple clusters detected"
    ]
  ];

  result
];


(* ================== TEST BEGIN ====================== *)



(* Example: Create a simple signed graph for testing *)
(* A 4-node signed graph with one negative edge as in Figure 1 of the paper *)
ExampleSignedGraph[] := {
  {0, 1, 0, 1},
  {1, 0, 1, 0},
  {0, 1, 0, -1},  (* Negative edge between nodes 3 and 4 *)
  {1, 0, -1, 0}
};

(* Test the algorithm *)
TestAlgorithm[] := Module[{signedGraph, result},
  Print["Testing Algorithm 1: Community-Faction Detection"];
  Print["========================================"];

  signedGraph = ExampleSignedGraph[];
  Print["Input signed adjacency matrix:"];
  Print[MatrixForm[signedGraph]];

  result = CommunityFactionDetection[signedGraph];

  Print["\nGremban Laplacian eigenvalues (sorted):"];
  Print[N[Sort[Eigenvalues[result["GrembanLaplacian"]]]]];

  Print["\nFiedler eigenvalue: ", N[result["FiedlerEigenvalue"]]];
  Print["Fiedler vector: ", N[result["FiedlerVector"]]];
  Print["Sign vector: ", result["SignVector"]];

  Print["\nSymmetric projection (c vector): ", N[result["SymmetricProjection"]]];
  Print["||c||_0 = ", result["SymmetricNorm"]];

  Print["\nAntisymmetric projection (f vector): ", N[result["AntisymmetricProjection"]]];
  Print["||f||_0 = ", result["AntisymmetricNorm"]];

  Print["\nDominant structure: ", result["DominantStructure"]];
  Print["Resulting partition: ", N[result["Partition"]]];

  result
];

(* Additional example: A more complex signed network with clear faction structure *)
FactionExample[] := {
  {0, 1, 1, -1, -1, 0},   (* Node 1: positive to 2,3; negative to 4,5 *)
  {1, 0, 1, -1, -1, 0},   (* Node 2: positive to 1,3; negative to 4,5 *)
  {1, 1, 0, -1, -1, 0},   (* Node 3: positive to 1,2; negative to 4,5 *)
  {-1, -1, -1, 0, 1, 1},  (* Node 4: negative to 1,2,3; positive to 5,6 *)
  {-1, -1, -1, 1, 0, 1},  (* Node 5: negative to 1,2,3; positive to 4,6 *)
  {0, 0, 0, 1, 1, 0}      (* Node 6: positive to 4,5 *)
};

(* Additional example: A community structure (all positive edges) *)
CommunityExample[] := {
  {0, 1, 1, 0, 0, 0},   (* First community: nodes 1,2,3 *)
  {1, 0, 1, 0, 0, 0},
  {1, 1, 0, 0, 0, 0},
  {0, 0, 0, 0, 1, 1},   (* Second community: nodes 4,5,6 *)
  {0, 0, 0, 1, 0, 1},
  {0, 0, 0, 1, 1, 0}
};

(* Test both examples *)
TestAllExamples[] := Module[{},
  Print["=" * 50];
  Print["EXAMPLE 1: Simple 4-node graph"];
  Print["=" * 50];
  TestAlgorithm[];

  Print["\n" <> "=" * 50];
  Print["EXAMPLE 2: Faction structure"];
  Print["=" * 50];
  Print["Testing faction example..."];
  result2 = CommunityFactionDetection[FactionExample[]];
  Print["Dominant structure: ", result2["DominantStructure"]];

  Print["\n" <> "=" * 50];
  Print["EXAMPLE 3: Community structure"];
  Print["=" * 50];
  Print["Testing community example..."];
  result3 = CommunityFactionDetection[CommunityExample[]];
  Print["Dominant structure: ", result3["DominantStructure"]];

  {result2, result3}
];

(* Algorithm 2: Multi-way clustering with the Gremban Laplacian *)
MultiWayCommunityFactionDetection[signedAdjacency_, k_] := Module[{
  n, grembanLaplacian, eigenSystem, eigenValues, eigenVectors,
  sortedIndices, spectralMatrix, clusterAssignments, clusters,
  grembanInvolution, clusterInterpretation, result
  },

  n = Length[signedAdjacency];

  (* Step 1: Compute the Gremban Laplacian *)
  grembanLaplacian = GrembanLaplacian[signedAdjacency];

  (* Step 2: Compute the first k-1 nontrivial eigenvectors *)
  eigenSystem = Eigensystem[grembanLaplacian];
  eigenValues = eigenSystem[[1]];
  eigenVectors = eigenSystem[[2]];

  (* Sort by eigenvalue and take first k-1 non-trivial (skip the first zero eigenvalue) *)
  sortedIndices = Ordering[eigenValues];
  spectralMatrix = Transpose[eigenVectors[[sortedIndices[[2 ;; k]]]]]; (* Y matrix (2n x k-1) *)

  (* Step 3: Simple clustering based on eigenvector signs *)
  clusters = Module[{firstEigenvector, signs, positiveNodes, negativeNodes},
    firstEigenvector = eigenVectors[[sortedIndices[[2]]]];
    signs = Sign[N[firstEigenvector]];
    positiveNodes = Flatten[Position[signs, 1]];
    negativeNodes = Flatten[Position[signs, -1]];

    (* Remove empty clusters and return non-empty ones *)
    DeleteCases[{positiveNodes, negativeNodes}, {}]
  ];

  (* Step 4: Simple interpretation - for demo purposes *)
  clusterInterpretation = Table[
    Module[{cluster, projectedNodes},
      cluster = clusters[[i]];
      projectedNodes = Union[Mod[cluster - 1, n] + 1]; (* Project to original node indices *)

      <|"Type" -> "Cluster", "Cluster" -> cluster, "ProjectedNodes" -> projectedNodes|>
    ],
    {i, Length[clusters]}
  ];

  result = <|
    "GrembanLaplacian" -> grembanLaplacian,
    "SpectralMatrix" -> spectralMatrix,
    "Clusters" -> clusters,
    "ClusterInterpretation" -> clusterInterpretation,
    "NumberOfClusters" -> k
  |>;

  result
];

(* Helper function to visualize cluster results *)
AnalyzeClusterStructure[result_] := Module[{interpretations, clusters},
  interpretations = result["ClusterInterpretation"];
  clusters = result["Clusters"];

  Print["Cluster Analysis:"];
  Print["==============="];
  Print["Total clusters found: ", Length[clusters]];

  Print["\nCluster details:"];
  Do[
    Print["  Cluster ", i, ": expanded nodes ", clusters[[i]],
          " -> original nodes ", interpretations[[i]]["ProjectedNodes"]],
    {i, Length[clusters]}
  ];

  Print["\nNote: This is a simplified implementation for demonstration."];
  Print["Full Algorithm 2 requires more sophisticated symmetry analysis."];
];

(* Simple test for the paper's 4-cycle example *)
TestSimple[] := Module[{signedGraph, result},
  Print["Testing simple 4-cycle with one negative edge"];
  Print["=============================================="];

  (* Create the exact example from Figure 1 of the paper *)
  signedGraph = {{0, 1, 0, 1}, {1, 0, 1, 0}, {0, 1, 0, -1}, {1, 0, -1, 0}};

  Print["Signed adjacency matrix:"];
  Print[MatrixForm[signedGraph]];

  result = CommunityFactionDetection[signedGraph];

  Print["\nResults:"];
  Print["Fiedler eigenvalue: ", N[result["FiedlerEigenvalue"]]];
  Print["Symmetric projection (c): ", N[result["SymmetricProjection"]]];
  Print["Antisymmetric projection (f): ", N[result["AntisymmetricProjection"]]];
  Print["||c||_0 = ", result["SymmetricNorm"]];
  Print["||f||_0 = ", result["AntisymmetricNorm"]];
  Print["Dominant structure: ", result["DominantStructure"]];

  result
];

(* Test Algorithm 2 with mixed community-faction structure *)
TestMultiWay[] := Module[{mixedGraph, result},
  Print["Testing Algorithm 2: Multi-way clustering"];
  Print["========================================="];

  (* Create a graph with both communities and factions *)
  (* Two communities (1,2,3) and (4,5,6) with factional structure within each *)
  mixedGraph = {
    {0, 1, 1, 0, 0, 0},   (* Node 1: positive to 2,3 (same community) *)
    {1, 0, -1, 0, 0, 0},  (* Node 2: positive to 1, negative to 3 (faction) *)
    {1, -1, 0, 0, 0, 0},  (* Node 3: positive to 1, negative to 2 (faction) *)
    {0, 0, 0, 0, 1, 1},   (* Node 4: positive to 5,6 (same community) *)
    {0, 0, 0, 1, 0, -1},  (* Node 5: positive to 4, negative to 6 (faction) *)
    {0, 0, 0, 1, -1, 0}   (* Node 6: positive to 4, negative to 5 (faction) *)
  };

  Print["Mixed community-faction adjacency matrix:"];
  Print[MatrixForm[mixedGraph]];

  result = MultiWayCommunityFactionDetection[mixedGraph, 4];

  Print["\nMulti-way clustering results:"];
  AnalyzeClusterStructure[result];

  result
];

(* Test with a simpler example - two communities *)
TestTwoCommunities[] := Module[{communityGraph, result},
  Print["Testing two separate communities"];
  Print["==============================="];

  (* Two disconnected communities *)
  communityGraph = {
    {0, 1, 1, 0, 0, 0},   (* Community 1: nodes 1,2,3 *)
    {1, 0, 1, 0, 0, 0},
    {1, 1, 0, 0, 0, 0},
    {0, 0, 0, 0, 1, 1},   (* Community 2: nodes 4,5,6 *)
    {0, 0, 0, 1, 0, 1},
    {0, 0, 0, 1, 1, 0}
  };

  Print["Two communities adjacency matrix:"];
  Print[MatrixForm[communityGraph]];

  result = MultiWayCommunityFactionDetection[communityGraph, 2];

  Print["\nTwo-community clustering results:"];
  AnalyzeClusterStructure[result];

  result
];

(* Comprehensive test suite *)
TestAlgorithm2[] := Module[{},
  Print["=" * 60];
  Print["TESTING ALGORITHM 2: MULTI-WAY CLUSTERING"];
  Print["=" * 60];

  Print["\nTest 1: Two separate communities"];
  TestTwoCommunities[];

  Print["\n" <> "=" * 40];
  Print["Test 2: Mixed community-faction structure"];
  TestMultiWay[];

  Print["\n" <> "=" * 40];
  Print["All Algorithm 2 tests completed"];
];

(* Final demonstration of both algorithms *)
DemonstrateBothAlgorithms[] := Module[{},
  Print["=========================================================="];
  Print["DEMONSTRATION OF BOTH ALGORITHMS FROM THE PAPER"];
  Print["=========================================================="];

  Print["\n1. ALGORITHM 1: Basic Community-Faction Detection"];
  Print["------------------------------------------------"];
  TestSimple[];

  Print["\n" <> "=" * 50];
  Print["2. ALGORITHM 2 CONCEPT: Multi-way clustering"];
  Print["(Note: Full implementation needs more sophisticated clustering)"];
  Print["---------------------------------------------"];

  (* Simple demonstration with a 4-node example *)
  Print["Testing 4-node balanced faction structure:"];
  Module[{balancedFaction, result1},
    balancedFaction = {{0, 1, -1, -1}, {1, 0, -1, -1}, {-1, -1, 0, 1}, {-1, -1, 1, 0}};
    Print["Matrix: ", MatrixForm[balancedFaction]];

    result1 = CommunityFactionDetection[balancedFaction];
    Print["Algorithm 1 result: ", result1["DominantStructure"]];
    Print["||c||_0 = ", result1["SymmetricNorm"], ", ||f||_0 = ", result1["AntisymmetricNorm"]];
  ];

  Print["\nBoth algorithms successfully demonstrate the Gremban expansion approach!"];
];

(* Run the tests when the file is loaded *)
Print["Gremban Algorithm Implementation Loaded"];
Print[""];
Print["Available functions:"];
Print["  TestSimple[] - Algorithm 1 basic test"];
Print["  TestAllExamples[] - Algorithm 1 comprehensive tests"];
Print["  TestAlgorithm2[] - Algorithm 2 multi-way clustering tests"];
Print["  DemonstrateBothAlgorithms[] - Summary demonstration"];
Print[""];
Print["Main algorithms:"];
Print["  CommunityFactionDetection[adjacencyMatrix] - Algorithm 1"];
Print["  MultiWayCommunityFactionDetection[adjacencyMatrix, k] - Algorithm 2"];

I am now looking for a review in terms of approach, clarity, performance, etc. Any help would be greatly appreciated.

\$\endgroup\$

0

Reset to default

You must log in to answer this question.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.