http://www.perlmonks.org?node_id=515307

japhy has asked for the wisdom of the Perl Monks concerning the following question:

I've got a data munging problem that is confusing me. I have a list of domain names and their associated WHOIS data (company, contact, address, phone, fax, email). I want to group domains together if they share at least two of those values. So if abc.com's company and phone are the same as def.com's company and phone, they should be in a group (array/hash, not important). But I also want to group xyz.com with abc.com and def.com if xyz.com shares two values with abc.com or def.com, and they needn't be the same fields as before. So if xyz.com's email and address are the same as def.com's email and address, it should be lumped together with abc.com and def.com.

Right now, I've got a bunch of data structures, but I don't know how to allocate this data into the "islands" of related domains. The word island is used because, when this is all done, the groups of domains will not have two values in common with any other groups.

My data structures are:

So, can anyone give me a good starting point? The killer is that the relationship has to be on TWO fields.

UPDATE

I think I've found a very different approach. I'm going through the list of domain names and building a hash $link{$d1}{$d2} = $degree_of_linkage based on the number of fields domains $d1 and $d2 have in common. Then I can use that to build my islands.

UPDATE

Here's the entirety of my code:
#!/usr/bin/perl use strict; use warnings; chomp(my @fields = split /\t/, <>); my (%domains, %links, %rel, %group); shift @fields; while (<>) { chomp; my ($dom, @values) = split /\t/, $_, -1; @{ $domains{$dom} }{@fields} = @values; } my @dlist = my @domain_list = keys %domains; while (@dlist) { my $d1 = shift @dlist; for my $d2 ($d1, @dlist) { $links{$d1}{$d2} = [ grep { $domains{$d1}{$_} eq $domains{$d2}{$_} and $domains{$d1}{$_} ne "" and $domains{$d1}{$_} ne "Private, Registration" and $domains{$d1}{$_} ne "Domains by Proxy, Inc." and $domains{$d1}{$_} !~ /^DomainsByProxy.com/i } @fields ]; } } for my $d1 (@domain_list) { $rel{$d1} ||= $d1; $group{ $rel{$d1} }{$d1} = 1; for my $d2 (grep { @{ $links{$d1}{$_} } > 1 } keys %{ $links{$d1} }) + { $rel{$d2} ||= $d1; $group{ $rel{$d2} }{$d2} = 1; } } for my $d1 (sort { keys(%{ $group{$b} }) <=> keys(%{ $group{$a} }) } k +eys %group) { print "GROUPED TO $d1\n"; for my $d2 (sort keys %{ $group{$d1} }) { print " $d2 (via: @{ $links{$d1}{$d2} })\n"; } }

Jeff japhy Pinyan, P.L., P.M., P.O.D, X.S.: Perl, regex, and perl hacker
How can we ever be the sold short or the cheated, we who for every service have long ago been overpaid? ~~ Meister Eckhart

Replies are listed 'Best First'.
Re: Building "islands" of related data
by jfroebe (Parson) on Dec 08, 2005 at 17:46 UTC

    Well, one way of doing it is with building indexes that contain references to the specified structures. Something like:

    my %company_phone_index = ( 'company' => "ABC Co.", 'phone' => "+1-888-123-4567", 'structs' => [ $company_one_ref, $company_two_ref ] );

    Atleast that should give you an idea. Note, you will have to handle the maintenance of the data (i.e. the company $company_one_ref closed down).

    Another method would be to put the structure into a database and create indexes on the desired traits so you can retrieve the 'groupings' of like data quickly.

    Jason L. Froebe

    Team Sybase member

    No one has seen what you have seen, and until that happens, we're all going to think that you're nuts. - Jack O'Neil, Stargate SG-1

Re: Building "islands" of related data
by Tanktalus (Canon) on Dec 08, 2005 at 17:50 UTC

    I would make some changes to your structures - namely, I'd abandon most of the arrays and use hashes. %domains would be a HoH where the lower-level H has the same keys as %data. This reduces a dependancy on data order which makes things clearer for me. Ignore this if you want.

    %data would become a HoHoA. For convenience and some sort of standardisation, I would have the outter key be lt the inner key. For example, $data{address}{company} would exist, but $data{company}{address} would not, although $data{company}{fax} would exist. Then it's just a matter of putting all your data in all appropriate buckets, and then finding which inner arrayrefs have more than one domain in them.

    There shouldn't be much memory usage here - just lots of refs.

Re: Building "islands" of related data
by BrowserUk (Patriarch) on Dec 09, 2005 at 01:02 UTC

    This sounds like it's related to Metric for confidence of complex match? Did that not work out, or did the specification change?


    Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
    Lingua non convalesco, consenesco et abolesco. -- Rule 1 has a caveat! -- Who broke the cabal?
    "Science is about questioning the status quo. Questioning authority".
    In the absence of evidence, opinion is indistinguishable from prejudice.
      That part worked fine, this is just a different way of handling the same data. It was much simpler than I thought it would be.

      Jeff japhy Pinyan, P.L., P.M., P.O.D, X.S.: Perl, regex, and perl hacker
      How can we ever be the sold short or the cheated, we who for every service have long ago been overpaid? ~~ Meister Eckhart
Re: Building "islands" of related data
by TedPride (Priest) on Dec 09, 2005 at 00:19 UTC
    The following performs as required, though the worst-case scenario can involve up to N(N-1)/2 domain comparisons. I hope you don't have more than a few thousand domains to do this with.
    use strict; use warnings; my (%domains, @domains, @sets, $i, $j); %domains = ( 'domain1.com' => ['company1', 'contact1', 'address1', 'phone1', 'fax1', 'email1 +'], 'domain2.com' => ['company2', 'contact2', 'address2', 'phone1', 'fax2', 'email1 +'], 'domain3.com' => ['company3', 'contact3', 'address3', 'phone3', 'fax3', 'email3 +'], 'domain4.com' => ['company3', 'contact4', 'address4', 'phone3', 'fax1', 'email1 +'], 'domain5.com' => ['company5', 'contact5', 'address5', 'phone5', 'fax5', 'email5 +'], 'domain6.com' => ['company5', 'contact6', 'address6', 'phone6', 'fax6', 'email5 +']); @domains = keys %domains; while ($#domains > -1) { my @newset = shift @domains; for ($i = 0; $i <= $#newset; $i++) { for ($j = 0; $j <= $#domains; $j++) { push @newset, splice(@domains, $j--, 1) if compare($newset[$i], $domains[$j]); } } push @sets, \@newset; } for (@sets) { print join ' ', sort @$_; print "\n"; } sub compare { my $d1 = $domains{$_[0]}; my $d2 = $domains{$_[1]}; my $c = 0; for (0..$#$d1) { return 1 if $d1->[$_] && $d1->[$_] eq $d2->[$_] && ++$c == 2; } }
Re: Building "islands" of related data
by Ryszard (Priest) on Dec 09, 2005 at 11:09 UTC
    ok, so, if performance, speed, and anything good is not a problem to trample on, how about this:
    #!/usr/bin/perl -w use strict; use Data::Dumper; use Digest::MD5 qw(md5_hex); # I want to group domains together if they share at least two of those + values. # The 1st two entires match, the 3rd not my %domains = ( 'foo.com' => { phone => '1234', company => 'big co', contact => 'john', address => 'cool street', fax => '5678', email => 'john@bigco.com', }, 'bar.com' => { phone => '2222', company => 'small co', contact => 'jeff', address => 'bad street', fax => '5678', email => 'john@bigco.com', }, 'baz.com' => { phone => '9999', company => 'another co', contact => 'judy', address => 'nasty street', fax => '8888', email => 'frank@anotherco.com', }, ); # Build permutation hash foreach my $domain (keys %domains) { # Iterate over all the elements in the domain hash foreach my $o_attr (keys %{$domains{$domain}}){ # As we're creating hashes of each permutation we need to iter +ate # over the same elements foreach my $i_attr (keys %{$domains{$domain}}){ $domains{$domain}{hash}{$o_attr}{$i_attr} = md5_hex(${$dom +ains{$domain}}{$o_attr}.${$domains{$domain}}{$i_attr}); } } } print Dumper(%domains);

    You can then loop over all the permutations looking for hashes that match!