comment on

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

In reply to Doing all combinations of comparisons between members of 2 lists by PetaMem

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		`&`
	<		`<`
	>		`>`
	[		`[`
	]		`]`

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.