I'd bet something like neo4j would be able to do this fairly quickly. Never actually used it but from (minimal) reading this type thing is right in its wheelhouse and it's got a REST api (and there's some promising hits on CPAN).

Thanks for the tip. Will investigate after some exposure to neo4j.

This time seems to be weight-y.

It's the same. Just another way of looking at it to get some kind of solution.

That's like crossposting and not really fair to us.
- Ron

This was fun :)

First part is basically the same as Re^3: Sub set where all are connected and finds all the cliques.

Last part looks for duplicated nodes, removes one of them from a clique such that the score is higher.

#!/usr/bin/perl

use strict; # https://perlmonks.org/?node_id=11109069 # clique
use warnings;
use List::Util qw( uniq sum );

my $edges = <<END =~ s/.*Relationship.*\n//gr;
Person-1  Person-2  Relationship-strength
A         B         92
A         C         7
B         C         2
C         D         88
END

$edges =~ s/^(\w+)\s+(\w+)\b/join ' ', sort $1, $2/gem;  # fix order
print "$edges\n";
my %edges = map +( $_ => qr/(*FAIL)/ ),
  map s/\s+/,/r, $edges =~ /^\w+\s+\w+/gm;
my %cliques;
my %seen;

find( uniq sort $edges =~ /^(\w+)\s+(\w+)\b/gm );    # start with ever
+y 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 eac
+h one
      {
      @_ > 1 and find( grep $_ ne $node, @_ );
      }
    }
  else
    {
    $cliques{ $set }++;                              # it is fully con
+nected
    }
  }

my $uniquecliques = '';
for ( sort { length $b <=> length $a } sort +uniq # ignore subsets
  keys %cliques, map tr/,/ /r, keys %edges )
  {
  my $pattern =  " $_ " =~ s/\w+/\\b$&\\b/gr =~ s/ /.*?/gr;
  $uniquecliques =~ /^$pattern$/m or $uniquecliques .= "$_\n";
  }

print "cliques:\n\n$uniquecliques";

my %scorecache;
sub scoreclique
  {
  $scorecache{ $_[0] } //= do
    {
    my $score = 0;
    "$_[0]:\n$edges" =~ /\b(\w+)\b.*\b(\w+)\b.*:.*^\1\s+\2\s+(\d+)\b(?
+{
      $score += $3 })(*FAIL)/ms;
    $score;
    }
  }

my @cliques = split /\n/, $uniquecliques;
my %count;
$count{$_}++ for split ' ', $uniquecliques;
for my $node ( map +($_) x --$count{$_}, keys %count ) # for all dups
  {
  my ($from, $to) = grep $cliques[$_] =~ /\b$node\b/, 0 .. $#cliques;
  my $fromscore = scoreclique($cliques[$from]) +
    scoreclique($cliques[$to] =~ s/\b$node\b//r);
  my $toscore = scoreclique($cliques[$to]) +
    scoreclique($cliques[$from] =~ s/\b$node\b//r);
  my $mod = $fromscore < $toscore ? $from : $to; # favor highest score
  $cliques[$mod] = join ' ', grep $_ ne $node, split ' ', $cliques[$mo
+d];
  }

my $total = sum map scoreclique($_), @cliques;
print "\nanswer($total):\n\n";
print "$_\n" for sort grep length, @cliques;

__END__
[download]

Outputs:

A B         92
A C         7
B C         2
C D         88

cliques:

A B C
C D

answer(180):

A B
C D
[download]

It passes all the test cases that have been provided :)

Thanks. Hope to test this solution for large data sets soon.