Skip to main content
added 99 characters in body
Source Link
kglr
  • 400.5k
  • 18
  • 488
  • 929

##ConnectedComponents

Using Daniel Lichtblau's answer to a related question

ConnectedComponents[Graph[UndirectedEdge @@@ pairs]]ConnectedComponents[pairs] //Sort /@#&@ # & //Sort (* thanks: CarlWoll *)

{{3, 5, 9},
{11, 21, 22, 35},
{12, 14, 16, 23},
{1, 6, 10, 13, 36},
{17, 20, 24, 25, 28, 32},
{2, 8, 15, 18, 27, 29, 31},
{4, 7, 19, 26, 30, 33, 34}}

In versions prior to 10.3 use

 ConnectedComponents[Graph[UndirectedEdge @@@ pairs]] //Sort /@ # & //Sort

##MatrixPower

Implementing transitive closure using MatrixPower:

m = Max@pairs;

(*the adjacency matrix of atomic elements in pairs:*)
SparseArray[pairs ~Append~ {i_, i_} -> 1, {m, m}];

(*symmetrize the adjacency matrix:*)
% + %\[Transpose] // Sign;

(*find the transitive closure:*)
Sign @ MatrixPower[N@%, m];

(*eliminate duplicate rows,and extract the atomic elements of pairs in each row:*)
Select[DeleteDuplicates @ Normal @ %, Tr@# > 1 &];
Join @@ Position[#, 1] & /@ %;

(*organize:*)
Sort[Sort /@ %]

{{3, 5, 9},
{11, 21, 22, 35},
{12, 14, 16, 23},
{1, 6, 10, 13, 36},
{17, 20, 24, 25, 28, 32},
{2, 8, 15, 18, 27, 29, 31},
{4, 7, 19, 26, 30, 33, 34}}

##ConnectedComponents

Using Daniel Lichtblau's answer to a related question

ConnectedComponents[Graph[UndirectedEdge @@@ pairs]] //Sort/@#& //Sort

{{3, 5, 9},
{11, 21, 22, 35},
{12, 14, 16, 23},
{1, 6, 10, 13, 36},
{17, 20, 24, 25, 28, 32},
{2, 8, 15, 18, 27, 29, 31},
{4, 7, 19, 26, 30, 33, 34}}

##MatrixPower

Implementing transitive closure using MatrixPower:

m = Max@pairs;

(*the adjacency matrix of atomic elements in pairs:*)
SparseArray[pairs ~Append~ {i_, i_} -> 1, {m, m}];

(*symmetrize the adjacency matrix:*)
% + %\[Transpose] // Sign;

(*find the transitive closure:*)
Sign @ MatrixPower[N@%, m];

(*eliminate duplicate rows,and extract the atomic elements of pairs in each row:*)
Select[DeleteDuplicates @ Normal @ %, Tr@# > 1 &];
Join @@ Position[#, 1] & /@ %;

(*organize:*)
Sort[Sort /@ %]

{{3, 5, 9},
{11, 21, 22, 35},
{12, 14, 16, 23},
{1, 6, 10, 13, 36},
{17, 20, 24, 25, 28, 32},
{2, 8, 15, 18, 27, 29, 31},
{4, 7, 19, 26, 30, 33, 34}}

##ConnectedComponents

Using Daniel Lichtblau's answer to a related question

ConnectedComponents[pairs] //Sort /@ # & //Sort (* thanks: CarlWoll *)

{{3, 5, 9},
{11, 21, 22, 35},
{12, 14, 16, 23},
{1, 6, 10, 13, 36},
{17, 20, 24, 25, 28, 32},
{2, 8, 15, 18, 27, 29, 31},
{4, 7, 19, 26, 30, 33, 34}}

In versions prior to 10.3 use

 ConnectedComponents[Graph[UndirectedEdge @@@ pairs]] //Sort /@ # & //Sort

##MatrixPower

Implementing transitive closure using MatrixPower:

m = Max@pairs;

(*the adjacency matrix of atomic elements in pairs:*)
SparseArray[pairs ~Append~ {i_, i_} -> 1, {m, m}];

(*symmetrize the adjacency matrix:*)
% + %\[Transpose] // Sign;

(*find the transitive closure:*)
Sign @ MatrixPower[N@%, m];

(*eliminate duplicate rows,and extract the atomic elements of pairs in each row:*)
Select[DeleteDuplicates @ Normal @ %, Tr@# > 1 &];
Join @@ Position[#, 1] & /@ %;

(*organize:*)
Sort[Sort /@ %]

{{3, 5, 9},
{11, 21, 22, 35},
{12, 14, 16, 23},
{1, 6, 10, 13, 36},
{17, 20, 24, 25, 28, 32},
{2, 8, 15, 18, 27, 29, 31},
{4, 7, 19, 26, 30, 33, 34}}

added 13 characters in body
Source Link
kglr
  • 400.5k
  • 18
  • 488
  • 929

##ConnectedComponents

Using Daniel Lichtblau's answer to a related question

 ConnectedComponents[Graph[UndirectedEdge @@@ pairs]] //Sort/@#& //Sort

{{3, 5, 9},
{11, 21, 22, 35},
{12, 14, 16, 23},
{1, 6, 10, 13, 36},
{17, 20, 24, 25, 28, 32},
{2, 8, 15, 18, 27, 29, 31},
{4, 7, 19, 26, 30, 33, 34}}

gives##MatrixPower

{{3, 5, 9}, 
 {11, 21, 22, 35}, 
 {12, 14, 16, 23}, 
 {1, 6, 10, 13, 36}, 
 {17, 20, 24, 25, 28, 32}, 
 {2, 8, 15, 18, 27, 29, 31}, 
 {4, 7, 19, 26, 30, 33, 34}}

EDIT: An alternative approach:Implementing transitive closure using MatrixPower: Implementing transitive closure using MatrixPower:

m = Max@pairs;

(*the adjacency matrix of atomic elements in pairs:*)
SparseArray[pairs ~Append~ {i_, i_} -> 1, {m, m}];

(*symmetrize the adjacency matrix:*)
% + %\[Transpose] // Sign;

(*find the transitive closure:*)
Sign @ MatrixPower[N@%, m];

(*eliminate duplicate rows,and extract the atomic elements of pairs in each row:*)
Select[DeleteDuplicates @ Normal @ %, Tr@# > 1 &];
Join @@ Position[#, 1] & /@ %;

(*organize:*)
Sort[Sort /@ %]

Results:

 {{3, 5, 9}, 
  {11, 21, 22, 35},
  {12, 14, 16, 23},
  {1, 6, 10, 13, 36}, 
  {17, 20, 24, 25, 28, 32}, 
  {2, 8, 15, 18, 27, 29, 31}, 
  {4, 7, 19, 26, 30, 33, 34}}

{{3, 5, 9},
{11, 21, 22, 35},
{12, 14, 16, 23},
{1, 6, 10, 13, 36},
{17, 20, 24, 25, 28, 32},
{2, 8, 15, 18, 27, 29, 31},
{4, 7, 19, 26, 30, 33, 34}}

Using Daniel Lichtblau's answer to a related question

 ConnectedComponents[Graph[UndirectedEdge @@@ pairs]] //Sort/@#& //Sort

gives

{{3, 5, 9}, 
 {11, 21, 22, 35}, 
 {12, 14, 16, 23}, 
 {1, 6, 10, 13, 36}, 
 {17, 20, 24, 25, 28, 32}, 
 {2, 8, 15, 18, 27, 29, 31}, 
 {4, 7, 19, 26, 30, 33, 34}}

EDIT: An alternative approach:Implementing transitive closure using MatrixPower:

m = Max@pairs;

(*the adjacency matrix of atomic elements in pairs:*)
SparseArray[pairs ~Append~ {i_, i_} -> 1, {m, m}];

(*symmetrize the adjacency matrix:*)
% + %\[Transpose] // Sign;

(*find the transitive closure:*)
Sign @ MatrixPower[N@%, m];

(*eliminate duplicate rows,and extract the atomic elements of pairs in each row:*)
Select[DeleteDuplicates @ Normal @ %, Tr@# > 1 &];
Join @@ Position[#, 1] & /@ %;

(*organize:*)
Sort[Sort /@ %]

Results:

 {{3, 5, 9}, 
  {11, 21, 22, 35},
  {12, 14, 16, 23},
  {1, 6, 10, 13, 36}, 
  {17, 20, 24, 25, 28, 32}, 
  {2, 8, 15, 18, 27, 29, 31}, 
  {4, 7, 19, 26, 30, 33, 34}}

##ConnectedComponents

Using Daniel Lichtblau's answer to a related question

ConnectedComponents[Graph[UndirectedEdge @@@ pairs]] //Sort/@#& //Sort

{{3, 5, 9},
{11, 21, 22, 35},
{12, 14, 16, 23},
{1, 6, 10, 13, 36},
{17, 20, 24, 25, 28, 32},
{2, 8, 15, 18, 27, 29, 31},
{4, 7, 19, 26, 30, 33, 34}}

##MatrixPower

Implementing transitive closure using MatrixPower:

m = Max@pairs;

(*the adjacency matrix of atomic elements in pairs:*)
SparseArray[pairs ~Append~ {i_, i_} -> 1, {m, m}];

(*symmetrize the adjacency matrix:*)
% + %\[Transpose] // Sign;

(*find the transitive closure:*)
Sign @ MatrixPower[N@%, m];

(*eliminate duplicate rows,and extract the atomic elements of pairs in each row:*)
Select[DeleteDuplicates @ Normal @ %, Tr@# > 1 &];
Join @@ Position[#, 1] & /@ %;

(*organize:*)
Sort[Sort /@ %]

{{3, 5, 9},
{11, 21, 22, 35},
{12, 14, 16, 23},
{1, 6, 10, 13, 36},
{17, 20, 24, 25, 28, 32},
{2, 8, 15, 18, 27, 29, 31},
{4, 7, 19, 26, 30, 33, 34}}

replaced http://mathematica.stackexchange.com/ with https://mathematica.stackexchange.com/
Source Link

Using Daniel Lichtblau's answerDaniel Lichtblau's answer to a related question related question

 ConnectedComponents[Graph[UndirectedEdge @@@ pairs]] //Sort/@#& //Sort

gives

{{3, 5, 9}, 
 {11, 21, 22, 35}, 
 {12, 14, 16, 23}, 
 {1, 6, 10, 13, 36}, 
 {17, 20, 24, 25, 28, 32}, 
 {2, 8, 15, 18, 27, 29, 31}, 
 {4, 7, 19, 26, 30, 33, 34}}

EDIT: An alternative approach:Implementing transitive closure using MatrixPower:

m = Max@pairs;

(*the adjacency matrix of atomic elements in pairs:*)
SparseArray[pairs ~Append~ {i_, i_} -> 1, {m, m}];

(*symmetrize the adjacency matrix:*)
% + %\[Transpose] // Sign;

(*find the transitive closure:*)
Sign @ MatrixPower[N@%, m];

(*eliminate duplicate rows,and extract the atomic elements of pairs in each row:*)
Select[DeleteDuplicates @ Normal @ %, Tr@# > 1 &];
Join @@ Position[#, 1] & /@ %;

(*organize:*)
Sort[Sort /@ %]

Results:

 {{3, 5, 9}, 
  {11, 21, 22, 35},
  {12, 14, 16, 23},
  {1, 6, 10, 13, 36}, 
  {17, 20, 24, 25, 28, 32}, 
  {2, 8, 15, 18, 27, 29, 31}, 
  {4, 7, 19, 26, 30, 33, 34}}

Using Daniel Lichtblau's answer to a related question

 ConnectedComponents[Graph[UndirectedEdge @@@ pairs]] //Sort/@#& //Sort

gives

{{3, 5, 9}, 
 {11, 21, 22, 35}, 
 {12, 14, 16, 23}, 
 {1, 6, 10, 13, 36}, 
 {17, 20, 24, 25, 28, 32}, 
 {2, 8, 15, 18, 27, 29, 31}, 
 {4, 7, 19, 26, 30, 33, 34}}

EDIT: An alternative approach:Implementing transitive closure using MatrixPower:

m = Max@pairs;

(*the adjacency matrix of atomic elements in pairs:*)
SparseArray[pairs ~Append~ {i_, i_} -> 1, {m, m}];

(*symmetrize the adjacency matrix:*)
% + %\[Transpose] // Sign;

(*find the transitive closure:*)
Sign @ MatrixPower[N@%, m];

(*eliminate duplicate rows,and extract the atomic elements of pairs in each row:*)
Select[DeleteDuplicates @ Normal @ %, Tr@# > 1 &];
Join @@ Position[#, 1] & /@ %;

(*organize:*)
Sort[Sort /@ %]

Results:

 {{3, 5, 9}, 
  {11, 21, 22, 35},
  {12, 14, 16, 23},
  {1, 6, 10, 13, 36}, 
  {17, 20, 24, 25, 28, 32}, 
  {2, 8, 15, 18, 27, 29, 31}, 
  {4, 7, 19, 26, 30, 33, 34}}

Using Daniel Lichtblau's answer to a related question

 ConnectedComponents[Graph[UndirectedEdge @@@ pairs]] //Sort/@#& //Sort

gives

{{3, 5, 9}, 
 {11, 21, 22, 35}, 
 {12, 14, 16, 23}, 
 {1, 6, 10, 13, 36}, 
 {17, 20, 24, 25, 28, 32}, 
 {2, 8, 15, 18, 27, 29, 31}, 
 {4, 7, 19, 26, 30, 33, 34}}

EDIT: An alternative approach:Implementing transitive closure using MatrixPower:

m = Max@pairs;

(*the adjacency matrix of atomic elements in pairs:*)
SparseArray[pairs ~Append~ {i_, i_} -> 1, {m, m}];

(*symmetrize the adjacency matrix:*)
% + %\[Transpose] // Sign;

(*find the transitive closure:*)
Sign @ MatrixPower[N@%, m];

(*eliminate duplicate rows,and extract the atomic elements of pairs in each row:*)
Select[DeleteDuplicates @ Normal @ %, Tr@# > 1 &];
Join @@ Position[#, 1] & /@ %;

(*organize:*)
Sort[Sort /@ %]

Results:

 {{3, 5, 9}, 
  {11, 21, 22, 35},
  {12, 14, 16, 23},
  {1, 6, 10, 13, 36}, 
  {17, 20, 24, 25, 28, 32}, 
  {2, 8, 15, 18, 27, 29, 31}, 
  {4, 7, 19, 26, 30, 33, 34}}
added 28 characters in body
Source Link
Mr.Wizard
  • 273.1k
  • 34
  • 595
  • 1.4k
Loading
added 2 characters in body
Source Link
Mr.Wizard
  • 273.1k
  • 34
  • 595
  • 1.4k
Loading
deleted 182 characters in body; edited body
Source Link
Mr.Wizard
  • 273.1k
  • 34
  • 595
  • 1.4k
Loading
matrixPower implementation of transitive closure
Source Link
kglr
  • 400.5k
  • 18
  • 488
  • 929
Loading
added 24 characters in body; added 21 characters in body
Source Link
kglr
  • 400.5k
  • 18
  • 488
  • 929
Loading
Source Link
kglr
  • 400.5k
  • 18
  • 488
  • 929
Loading