#!/usr/bin/perl use strict; # https://perlmonks.org/?node_id=11109069 # clique use warnings; use List::Util qw( uniq ); my $edges = < '(*FAIL)' ), $edges =~ /\w+,\w+/g; my %cliques; my %seen; find( uniq sort $edges =~ /\w+/g ); # start with every node sub find { $seen{ my $set = "@_" }++ and return; if( my @out = $set =~ /\b(\w+)\b.+\b(\w+)\b(??{ $edges{"$1,$2"} || "" })/ ) { for my $node ( @out ) # pair of unconnected nodes, try without each one { @_ > 3 and find( grep $_ ne $node, @_ ); } } else { $cliques{ $set }++; # it is fully connected } } my $uniquecliques = ''; for ( sort { length $b <=> length $a } sort +uniq keys %cliques, map tr/,/ /r, keys %edges ) { my $pattern = " $_ " =~ s/\w+/\\b$&\\b/gr =~ s/ /.*?/gr; $uniquecliques =~ /^$pattern$/m or $uniquecliques .= "$_\n"; } print $uniquecliques; #### [1,2],[1,3],[1,4], [2,3],[2,4], [3,4], [4,5],[23,4], [5,6],[5,7],[5,8], [6,7], [7,8], [8,9],[10,8], [10,9],[11,9],[12,9],[13,9], [10,13], [11,12],[11,13], [12,13], [13,14], [14,15],[14,21], [15,16],[15,17],[15,19], [16,17], [17,18],[17,19], [18,19],[18,20],[18,21], [19,20],[19,21],[19,22], [20,23], [21,22],[21,23], [22,23], 11 12 13 9 15 16 17 15 17 19 17 18 19 18 19 20 18 19 21 19 21 22 21 22 23 1 2 3 4 10 13 9 10 8 9 13 14 14 15 14 21 20 23 5 6 7 5 7 8 23 4 4 5