[CDBI] using CDBI to probe data relationships

[prev] [thread] [next] [Date index for 2005/12/20]

From: Todd W
Subject: [CDBI] using CDBI to probe data relationships
Date: 23:35 on 20 Dec 2005
I read an article on perl.com about using prolog to solve relationship
queries. If anything, it helped quantify some of the questions/musings/ideas
I've had about the problem space. Here is a link to the article:

http://www.perl.com/pub/a/2005/12/15/perl_prolog.html

Here is the comment I posted to the article:

Thanks for the article. This is a problem space I have been thinking about a
lot lately.

Your article has definitely made me aware of what Prolog is and made me want
to start looking in to it to solve relationship problems.

After getting your example running, I solved the problem using my solution
to this kind of thing. It involves a rdbms (mysql in this case), perl, and
Class::DBI.

I am NOT saying which way is better, more efficient, more scaleable, etc,
etc... It is just how I would have done it had I never read this article.

I am definitely interested in a discussion on how the two solutions might be
merged together for optimization (think large data sets).

The beginning of the program sets up the Class::DBI subclass and two CDBI
classes. The first class abstracts a table with two columns, id and name.
The second class is a mapping class used to signify a parent <-> child
relationship between two people.

The driver part of the code loops over each person in the table. For each
person in the table, another loop over each person in the table is ran.
Inside the looping code, a check is made to see if the two people are
cousins. If they are, a message is printed to the screen.

There is some SQL after the __END__ marker to recreate the tables.

Here is the output of the program:
$ perl ancestry.pl
ann and sara are cousins
ann and mike are cousins
joe and sara are cousins
joe and mike are cousins
sara and ann are cousins
sara and joe are cousins
mike and ann are cousins
mike and joe are cousins

and now the code :0)

use warnings;
use strict;

package FamilyTree::DBI;
use base qw|Class::DBI|;

our($dsn, $user, $pass) = qw(dbi:mysql:test user pass);
__PACKAGE__->connection( $dsn, $user, $pass );

package FamilyTree::Person;
use base qw|FamilyTree::DBI|;

__PACKAGE__->table("people");
__PACKAGE__->columns(All => qw(id name));

__PACKAGE__->has_many(
  children =>
  [ 'FamilyTree::Relationship' => 'child' ] =>
  'parent'
);

__PACKAGE__->has_many(
  parents =>
  [ 'FamilyTree::Relationship' => 'parent' ] =>
  'child'
);

sub is_sibling {
  my( $self, $person ) = @_;
  return if ( $self->id == $person->id );

  my $sql = 'SELECT DISTINCT parent FROM parentchild where child in (?, ?)';
  my $sth = __PACKAGE__->db_Main->prepare( $sql );
  $sth->execute( $self->id, $person->id );

  my $count = @{ $sth->fetchall_arrayref };
  $sth->finish;

  return( $count == 2 ? 1 : 0 );
}

sub is_cousin {
  my( $self, $person ) = @_;

  return if ( $self->id == $person->id );
  return if ( $self->is_sibling( $person ) );

  my @parents = $self->parents;

  # Danish word for aunt or uncle
  my @onkel = $person->parents;

  my $sql = <<'  END_OF_SQL';
    SELECT
      count(id) AS counter
    FROM
      parentchild
    WHERE
      child IN (?, ?, ?, ?)
    GROUP BY
      parent
    HAVING
      counter > 1
  END_OF_SQL

  my $sth = __PACKAGE__->db_Main->prepare( $sql );
  $sth->execute( map $_->id, @parents, @onkel );
  my $result = $sth->fetchrow_array;
  $sth->finish;

  return( $result ? 1 : 0 );
}

package FamilyTree::Relationship;
use base qw|FamilyTree::DBI|;

__PACKAGE__->table("parentchild");
__PACKAGE__->columns(All => qw(id parent child));

__PACKAGE__->has_a( parent => 'FamilyTree::Person' );
__PACKAGE__->has_a( child => 'FamilyTree::Person' );

package main;

my $people = FamilyTree::Person->retrieve_all;
while ( my $person = $people->next ) {
  my $cousins = FamilyTree::Person->retrieve_all;
  while ( my $cousin = $cousins->next ) {
    if ( $person->is_cousin( $cousin ) ) {
      print( $person->name, ' and ', $cousin->name, " are cousins\n" );
    }
  }
}

__END__

CREATE TABLE people (
  id int(10) unsigned NOT NULL auto_increment,
  name varchar(31) NOT NULL default '',
  PRIMARY KEY  (id),
  UNIQUE KEY id (id),
  KEY id_2 (id)
) TYPE=MyISAM;

INSERT INTO people VALUES (NULL,'chris');
INSERT INTO people VALUES (NULL,'lucy');
INSERT INTO people VALUES (NULL,'jim');
INSERT INTO people VALUES (NULL,'nan');
INSERT INTO people VALUES (NULL,'tom');
INSERT INTO people VALUES (NULL,'steve');
INSERT INTO people VALUES (NULL,'kate');
INSERT INTO people VALUES (NULL,'jill');
INSERT INTO people VALUES (NULL,'rob');
INSERT INTO people VALUES (NULL,'sue');
INSERT INTO people VALUES (NULL,'dan');
INSERT INTO people VALUES (NULL,'ann');
INSERT INTO people VALUES (NULL,'joe');
INSERT INTO people VALUES (NULL,'sara');
INSERT INTO people VALUES (NULL,'mike');

CREATE TABLE parentchild (
  id int(10) unsigned NOT NULL auto_increment,
  parent int(10) unsigned NOT NULL default '0',
  child int(10) unsigned NOT NULL default '0',
  PRIMARY KEY  (id),
  UNIQUE KEY id (id),
  KEY id_2 (id)
) TYPE=MyISAM;

INSERT INTO parentchild VALUES (NULL,1,8);
INSERT INTO parentchild VALUES (NULL,2,8);
INSERT INTO parentchild VALUES (NULL,3,9);
INSERT INTO parentchild VALUES (NULL,4,9);
INSERT INTO parentchild VALUES (NULL,4,10);
INSERT INTO parentchild VALUES (NULL,5,10);
INSERT INTO parentchild VALUES (NULL,6,11);
INSERT INTO parentchild VALUES (NULL,7,11);
INSERT INTO parentchild VALUES (NULL,8,12);
INSERT INTO parentchild VALUES (NULL,9,12);
INSERT INTO parentchild VALUES (NULL,8,13);
INSERT INTO parentchild VALUES (NULL,9,13);
INSERT INTO parentchild VALUES (NULL,10,14);
INSERT INTO parentchild VALUES (NULL,11,14);
INSERT INTO parentchild VALUES (NULL,10,15);
INSERT INTO parentchild VALUES (NULL,11,15);


_______________________________________________
ClassDBI mailing list
ClassDBI@xxxxx.xxxxxxxxxxxxxxxx.xxx
http://lists.digitalcraftsmen.net/mailman/listinfo/classdbi

[CDBI] using CDBI to probe data relationships
Todd W 23:35 on 20 Dec 2005

Generated at 01:21 on 10 Jan 2006 by mariachi v0.52