Doing all combinations of comparisons between members of 2 lists

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

Yeah!

Brethren,

I'm wading knee-deep in code I thought would be quite simple. Code that should just state whether the structure of two trees is identical or not.

If I remember my lessons correctly this is to state whether the trees are isomorphous or not. The trees are instances of the Tree::Nary data structure. So far so good, I have done all the basic checks (leaf/non-leaf comparisons, amount of children etc.), and now I need the core code for the recursive comparison.

This code should handle the following:

given two lists of references; the lists have always same length (amount of members).
Thus if n=scalar(@list1) and m=scalar(@list2), n=m and thus the number of comparison-alternatives is also n.
Do all comparison alternatives at least one (but could be more) alternative has to result in a successfull comparison else return FALSE
memoize the successfull comparison alternative(s)
for every alternative, for every list-member pair:
call the whole sub recursively

I guess I'm big messed up here... :-P Code so far:

# {{{ tstruct                      have 2 trees same structure? (must 
+be normalized)
#
sub tstruct {
  my $t1   = shift;                  # get reference to "root" of tree
+1
  my $t2   = shift;                  # get reference to "root" of tree
+2
  my $safe = shift || FALSE;         # Flag for safe comparison (norma
+lize first)

  if($safe == TRUE) {                # If safe comparison should happe
+n
    &tnormalize($t1);                # Normalize Tree1
    &tnormalize($t2);                # Normalize Tree2
  }

  # Exit if one of them is leaf and the other isn't
  return FALSE if(( $t1->is_leaf($t1) && !$t2->is_leaf($t2)) or
          (!$t1->is_leaf($t1) &&  $t2->is_leaf($t2)));
  # exit if they have different amount of children
  return FALSE if($t1->n_children($t1) != $t2->n_children($t2));

  return TRUE  if($t1->is_leaf($t1));   # if t1 is leaf -> both are: O
+K

  # => HERE BOTH ARE PARENTS WITH SAME AMOUNT OF CHILDREN

  # get the children references for $t1 and $t2
  my @t1childs;
  my @t2childs;
  $t1->children_foreach($t1,$Tree::Nary::TRAVERSE_ALL,\&_pchild_ref,\@
+t1childs);
  $t2->children_foreach($t2,$Tree::Nary::TRAVERSE_ALL,\&_pchild_ref,\@
+t2childs);
  # get the amount of grandchildren ordered
  my %grand1;
  my %grand2;
  for my $i (0 ... scalar(@t1childs)-1) {     # iterate all children b
+y index
    my $ngk1 = $t1childs[$i]->n_children($t1childs[$i]);   # amount of
+ grandkids1
    my $ngk2 = $t2childs[$i]->n_children($t2childs[$i]);   # amount of
+ grandkids2
    $grand1{$ngk1} = () if(!exist($grand1{$ngk1}));
    push $grand1{$ngk1}, $t1childs[$i];
    $grand2{$ngk2} = () if(!exist($grand2{$ngk2}));
    push $grand2{$ngk2}, $t2childs[$i++];
  }
  # NOW WE HAVE IN THE grand1 & grand2 HASHES THE DISTRIBUTION OF THE 
+GRANDCHILDREN
  # OF THE CHILDREN PLUS THE CORRESPONDENDING CHILDREN REFERENCES

  # ensure, that the distributions have same amount of entries
  return FALSE if(scalar(keys %grand1) != scalar(keys %grand2));

  while (my ($key, $value) = each %grand1) {  # iterate all T1 grandch
+ild distributions
    # exit if distribution varies, because they must have same length 
+also,
    # the following condition ensures we have same distribution in gra
+nd1 and grand2
    return FALSE if(scalar($grand1{$key}) != scalar($grand2{$key}));
  }
  # NO WE HAVE TWO IDENTICAL DISTRIBUTIONS AT CHILD/GRANDCHILD LEVEL
  while (my ($key, $value) = each %grand1) {  # iterate all T1 grandch
+ild distributions
    if($key > 0) {   # we don't need to consider children that are lea
+fs
      
      # ULTRABRUTAL CORE RECURSIVE DESCENT COMPARISON ROUTINE HERE
      # VODOO, BLACK MAGIC, SILVER BULLETS, DIVINE INTERVENTION
    }
  }

  return TRUE;
}
# }}}
[download]

Bye
PetaMem All Perl: MT, NLP, NLU

Comment on Doing all combinations of comparisons between members of 2 lists Download Code

Replies are listed 'Best First'.
Re: Doing all combinations of comparisons between members of 2 lists by demerphq (Chancellor) on Oct 07, 2003 at 14:59 UTC
Er, maybe have a look at Test::Differences and Test::Deep. Or you can /msg me an email address and ill send you a module I wrote that does this. --- demerphq _{First they ignore you, then they laugh at you, then they fight you, then you win. -- Gandhi}	[reply] [d/l]
Re: Doing all combinations of comparisons between members of 2 lists by Thelonius (Priest) on Oct 07, 2003 at 16:09 UTC
I think this will do what you want. It's not really been tested except in the most trivial way. Memoization is left as an exercise for the reader. sub tstruct { my $t1 = shift; # get reference to "root" of tree1 my $t2 = shift; # get reference to "root" of tree2 my $safe = shift \|\| FALSE; # Flag for safe comparison (normalize fi +rst) if($safe == TRUE) { # If safe comparison should happen &tnormalize($t1); # Normalize Tree1 &tnormalize($t2); # Normalize Tree2 } # Exit if one of them is leaf and the other isn't return FALSE if(( $t1->is_leaf($t1) && !$t2->is_leaf($t2)) or (!$t1->is_leaf($t1) && $t2->is_leaf($t2))); # exit if they have different amount of children return FALSE if($t1->n_children($t1) != $t2->n_children($t2)); return TRUE if($t1->is_leaf($t1)); # if t1 is leaf -> both are: O +K # => HERE BOTH ARE PARENTS WITH SAME AMOUNT OF CHILDREN my $nchild = $t1->n_children($t1); my @permutes = 0 .. $nchild - 1; do { PERMUTATION: { for my $i (0 .. $nchild - 1) { if (!tstruct($t1->nth_child($t1, $i), $t2->nth_child($t2, $permutes[$i]))) { next PERMUTATION } } # if we make it here, all children compared okay, return TRUE; }} while (nextperm(\@permutes)); return FALSE; } # }}} # From Algorithm L in Knuth Vol. 4 Sec 7.2.1.2 (not yet published) sub nextperm { my ($arrayref) = @_; my $n = @{$arrayref}; my $j = $n - 2; while ($j >= 0 && ${$arrayref}[$j] >= ${$arrayref}[$j+1]) { $j--; } return 0 if $j < 0; my $q = $n - 1; while (${$arrayref}[$j] >= ${$arrayref}[$q]) { $q--; } # swap a[q], a[j] (${$arrayref}[$q], ${$arrayref}[$j]) = (${$arrayref}[$j], ${$arrayref}[$q]); @{$arrayref}[$j+1 .. $n-1] = reverse @{$arrayref}[$j+1 .. $n-1]; return 1; } [download]	[reply] [d/l]
Re: Re: Doing all combinations of comparisons between members of 2 lists by PetaMem (Priest) on Oct 08, 2003 at 08:24 UTC
Hi, thanks for your reply. I stumbled across permutation also. An elegant way seems to be to use: List::Permutor. Unfortunatedly the runtime efficiency of anything that uses this is O(n!) which is even worse than exponential. Oh my... Bye PetaMem All Perl: MT, NLP, NLU	[reply]
Re: Doing all combinations of comparisons between members of 2 lists by Thelonius (Priest) on Oct 08, 2003 at 10:58 UTC
Unfortunatedly the runtime efficiency of anything that uses this is O(n!) which is even worse than exponential. Oh my... Oh, you want an efficient algorithm. Why didn't you say so? There's a linear-time bottom-up algorithm in Aho, Hopcroft, Ullman's The Design and Analysis of Algorithms. Online I've found it at http://cgm.cs.mcgill.ca/~msuder/courses/250/assignments/5/5.pdf	[reply]