Return to Answer

Update

On reflection I think using ConnectedComponents as referenced in the accepted answer to (4843) and used by ubpdqn in his answer is probably the best approach. Here is my implementation of that idea.

fn2[data_] :=
  UndirectedEdge @@@ Partition[#, 2, 1, 1] & /@ GatherBy[data, #] & /@ {First, Last} // 
    Flatten // Graph // ConnectedComponents

Tested on Question example:

data = {{1, 2}, {3, 1}, {1, 5}, {6, 2}, {7, 3}, {4, 4}, {5, 4}, {0, 0}, {2, 3}, {6, 7}};

fn2[data] // Column

{{6, 7}, {6, 2}, {1, 2}, {1, 5}}
{{4, 4}, {5, 4}}
{{7, 3}, {2, 3}}
{{0, 0}}
{{3, 1}}

Speed on a large set:

SeedRandom[1]
big = RandomInteger[25000, {50000, 2}];

fn2[big] // Length // RepeatedTiming

{0.407, 1356}

Old idea

This is probably pretty rough but I am in a rush. Hopefully it is correct and serves as a basis for something that can be cleaned up.

data = {{1, 2}, {3, 1}, {1, 5}, {6, 2}, {7, 3}, {4, 4}, {5, 4}, {0, 0}, {2, 3}, {6, 7}};

asc1 = GroupBy[data, First];
asc2 = GroupBy[data, Last -> First];

Union @@@ Map[asc2] /@ asc1[[All, All, 2]];
Union @@@ Map[asc1] /@ Union @ Values @ %

{
 {{0, 0}},
 {{3, 1}},
 {{1, 2}, {1, 5}, {6, 2}, {6, 7}},
 {{2, 3}, {7, 3}},
 {{4, 4}, {5, 4}}
}

Update

On reflection I think using ConnectedComponents as referenced in the accepted answer to (4843) and used by ubpdqn in his answer is probably the best approach. Here is my implementation of that idea.

fn2[data_] :=
  UndirectedEdge @@@ Partition[#, 2, 1, 1] & /@ GatherBy[data, #] & /@ {First, Last} // 
    Flatten // Graph // ConnectedComponents

Tested on Question example:

data = {{1, 2}, {3, 1}, {1, 5}, {6, 2}, {7, 3}, {4, 4}, {5, 4}, {0, 0}, {2, 3}, {6, 7}};

fn2[data] // Column

{{6, 7}, {6, 2}, {1, 2}, {1, 5}}
{{4, 4}, {5, 4}}
{{7, 3}, {2, 3}}
{{0, 0}}
{{3, 1}}

Speed on a large set:

SeedRandom[1]
big = RandomInteger[25000, {50000, 2}];

fn2[big] // Length // RepeatedTiming

{0.407, 1356}

Old idea

This is probably pretty rough but I am in a rush. Hopefully it is correct and serves as a basis for something that can be cleaned up.

data = {{1, 2}, {3, 1}, {1, 5}, {6, 2}, {7, 3}, {4, 4}, {5, 4}, {0, 0}, {2, 3}, {6, 7}};

asc1 = GroupBy[data, First];
asc2 = GroupBy[data, Last -> First];

Union @@@ Map[asc2] /@ asc1[[All, All, 2]];
Union @@@ Map[asc1] /@ Union @ Values @ %

{
 {{0, 0}},
 {{3, 1}},
 {{1, 2}, {1, 5}, {6, 2}, {6, 7}},
 {{2, 3}, {7, 3}},
 {{4, 4}, {5, 4}}
}

This is probably pretty rough but I am in a rush. Hopefully it is correct and serves as a basis for something that can be cleaned up.

Edit: a touch cleaner now.

data = {{1, 2}, {3, 1}, {1, 5}, {6, 2}, {7, 3}, {4, 4}, {5, 4}, {0, 0}, {2, 3}, {6, 7}};

asc1 = GroupBy[data, First];
asc2 = GroupBy[data, Last -> First];

Union @@@ Map[asc2] /@ asc1[[All, All, 2]];
Union @@@ Map[asc1] /@ Union @ Values @ %

{
 {{0, 0}},
 {{3, 1}},
 {{1, 2}, {1, 5}, {6, 2}, {6, 7}},
 {{2, 3}, {7, 3}},
 {{4, 4}, {5, 4}}
}

Update

On reflection I think using ConnectedComponents as referenced in the accepted answer to (4843) and used by ubpdqn in his answer is probably the best approach. Here is my implementation of that idea.

fn2[data_] :=
  UndirectedEdge @@@ Partition[#, 2, 1, 1] & /@ GatherBy[data, #] & /@ {First, Last} // 
    Flatten // Graph // ConnectedComponents

Tested on Question example:

data = {{1, 2}, {3, 1}, {1, 5}, {6, 2}, {7, 3}, {4, 4}, {5, 4}, {0, 0}, {2, 3}, {6, 7}};

fn2[data] // Column

{{6, 7}, {6, 2}, {1, 2}, {1, 5}}
{{4, 4}, {5, 4}}
{{7, 3}, {2, 3}}
{{0, 0}}
{{3, 1}}

Speed on a large set:

SeedRandom[1]
big = RandomInteger[25000, {50000, 2}];

fn2[big] // Length // RepeatedTiming

{0.407, 1356}

Old idea

This is probably pretty rough but I am in a rush. Hopefully it is correct and serves as a basis for something that can be cleaned up.

data = {{1, 2}, {3, 1}, {1, 5}, {6, 2}, {7, 3}, {4, 4}, {5, 4}, {0, 0}, {2, 3}, {6, 7}};

asc1 = GroupBy[data, First];
asc2 = GroupBy[data, Last -> First];

Union @@@ Map[asc2] /@ asc1[[All, All, 2]];
Union @@@ Map[asc1] /@ Union @ Values @ %

{
 {{0, 0}},
 {{3, 1}},
 {{1, 2}, {1, 5}, {6, 2}, {6, 7}},
 {{2, 3}, {7, 3}},
 {{4, 4}, {5, 4}}
}

This is probably pretty rough but I am in a rush. Hopefully it is correct and serves as a basis for something that can be cleaned up.

data = {{1, 2}, {3, 1}, {1, 5}, {6, 2}, {7, 3}, {4, 4}, {5, 4}, {0, 0}, {2, 3}, {6, 7}};

asc1 = GroupBy[data, First -> Last];
asc2 = GroupBy[data, Last -> First];

Union @@@ Map[asc2] /@ asc1 // DeleteDuplicates;
Union @@@ Map@GroupBy[data, First] /@ % // Values

{
 {{1, 2}, {1, 5}, {6, 2}, {6, 7}},
  {{3, 1}},
 {{2, 3}, {7, 3}},
 {{4, 4}, {5, 4}},
 {{0, 0}}
}

This is probably pretty rough but I am in a rush. Hopefully it is correct and serves as a basis for something that can be cleaned up.

Edit: a touch cleaner now.

data = {{1, 2}, {3, 1}, {1, 5}, {6, 2}, {7, 3}, {4, 4}, {5, 4}, {0, 0}, {2, 3}, {6, 7}};

asc1 = GroupBy[data, First];
asc2 = GroupBy[data, Last -> First];

Union @@@ Map[asc2] /@ asc1[[All, All, 2]];
Union @@@ Map[asc1] /@ Union @ Values @ %

{
 {{0, 0}}, 
 {{3, 1}}, 
 {{1, 2}, {1, 5}, {6, 2}, {6, 7}},
 {{2, 3}, {7, 3}},
 {{4, 4}, {5, 4}}
}