Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change
 
PerlMonks  

Tree Structure Challenge

by choroba (Cardinal)
on Nov 29, 2015 at 23:29 UTC ( [id://1148837]=perlmeditation: print w/replies, xml ) Need Help??

At work, I needed to fix logging of changes in a tree structure. The language was unfortunately Java, but I started with a Perl prototype to test the approaches and border cases. The Java solution was more challenging for me, but the Perl implementation was still interesting enough to share. For those bored or interested, I present the problem below. The original domain was different, but I'm probably not allowed to speak about it outside of the firm.

We'll use the famous animal tree:

Reptile - Snake - Python - Cobra - Lizard - Salamander - Chameleon - Bird - Pigeon - Canary - Owl Mammal - Equine - Horse - Zebra - Pony - Canine - Dog - Fox - Wolf - Bovine - Cow - Bison

All the leaves are on the same level.

Let's have a module Zoo.pm which implements the following methods:

Parent

Static method. 'Zoo'->Parent($node) returns the parent of the given node in the tree, e.g. 'Zoo'->Parent('Owl') is 'Bird', 'Zoo'->Parent('Bird') is 'Reptile'.

new

The constructor. Use a list of tree leaves as arguments:

my $zoo = 'Zoo'->new(qw( Cobra Pigeon Zebra ));

get_leaves

For a given object, returns the list it was constructed from (order is not guaranteed).

print join ' ', $zoo->get_leaves; # Cobra Pigeon Zebra

The Task

When comparing too different zoos, we aren't interested in the animals only, but in their categories, too. Our task is to implement a static method 'Zoo'->diff($zoo1, $zoo2) which returns two array references, $add and $delete, such that:

  1. Imagine we build trees above both of the objects, containing all their $_->get_leaves and their ancestors.
  2. If we start from the tree built above $zoo1, add all the nodes from $add and remove all nodes from $delete, we get $zoo2.
  3. Both the lists @$add and @$delete are minimal.

For example,

'Zoo'->diff( 'Zoo'->new('Cobra'), 'Zoo'->new('Fox') )

should return

( [qw[ Fox Canine Mammal ]], [qw[ Cobra Snake Reptile ]] )

Similarly,

'Zoo'->diff( 'Zoo'->new(qw( Dog Fox Wolf )), 'Zoo'->new(qw( Fox )));

should return

( [], [ 'Dog', 'Wolf' ] )

Updates: Please, use <readmore> tags for the code.

Use only the documented API in the solution (i.e. Parent and get_leaves). The tree structure is not accessible directly (in reality, it was stored in a database).

($q=q:Sq=~/;[c](.)(.)/;chr(-||-|5+lengthSq)`"S|oS2"`map{chr |+ord }map{substrSq`S_+|`|}3E|-|`7**2-3:)=~y+S|`+$1,++print+eval$q,q,a,

Replies are listed 'Best First'.
Re: Tree Structure Challenge
by Anonymous Monk on Nov 29, 2015 at 23:42 UTC
    #!/usr/bin/perl -- use strict; use warnings; use Data::Dump qw/ dd /; dd( deeef( 'Cobra', 'Fox' ) ); #~ should return #~ ( [qw[ Fox Canine Mammal ]], #~ [qw[ Cobra Snake Reptile ]] #~ ) sub deeef { my( @animals ) = @_; my %catcatdog = ( Mammal => { Bovine => ["Cow", "Bison"], Canine => ["Dog", "Fox", "Wolf"], Equine => ["Horse", "Zebra", "Pony"], }, Reptile => { Bird => ["Pigeon", "Canary", "Owl"], Lizard => ["Salamander", "Chameleon"], Snake => ["Python", "Cobra"], }, ); my %dogcatcat; for my $cat ( keys %catcatdog ){ for my $catcat ( keys %{ $catcatdog{ $cat } } ){ for my $dog( @{ $catcatdog{$cat}{$catcat} } ){ #~ $dogcatcat{$dog}{$cat}{$catcat}++; #~ $dogcatcat{$dog}{$catcat}++; #~ $dogcatcat{$dog}{$cat}++; push @{ $dogcatcat{$dog} }, $catcat, $cat, ; } } } #~ return map {; [ $_, keys %{ $dogcatcat{$_} } ] } @animals; return map {; [ $_, @{ $dogcatcat{$_} } ] } @animals; }
      How should I run your solution to get the result for the following?
      'Zoo'->diff( 'Zoo'->new(qw( Dog Fox Wolf )), 'Zoo'->new(qw( Fox )));

      Not saying that I'm getting

      Can't use an undefined value as an ARRAY reference at ./zoo.pl line 40 +.
      ($q=q:Sq=~/;[c](.)(.)/;chr(-||-|5+lengthSq)`"S|oS2"`map{chr |+ord }map{substrSq`S_+|`|}3E|-|`7**2-3:)=~y+S|`+$1,++print+eval$q,q,a,

        How should I run your solution to get the result for the following?

        What should the result look like?

        Not saying that I'm getting ...

        Huh?

        dd( deeef( qw/ Dog Fox Wolf / ) ); __END__ ( ["Dog", "Canine", "Mammal"], ["Fox", "Canine", "Mammal"], ["Wolf", "Canine", "Mammal"], )
Re: Tree Structure Challenge
by LanX (Saint) on Nov 30, 2015 at 20:47 UTC
    I'm not sure if I get the problem, the naive solution is to collect all nodes from each tree with successive ->Parent calls and to construct the difference with cut operations. (like deleting hash slices)

    What am I missing?

    If the goal is to have minimal numbers of operations, we'd need to know things like if all leaves have the same distance to root.

    Cheers Rolf
    (addicted to the Perl Programming Language and ☆☆☆☆ :)
    Je suis Charlie!

      Basically, yes, that's it. One has to be careful with the bordercases, as usually. All leaves have the same distance to the root.
      ($q=q:Sq=~/;[c](.)(.)/;chr(-||-|5+lengthSq)`"S|oS2"`map{chr |+ord }map{substrSq`S_+|`|}3E|-|`7**2-3:)=~y+S|`+$1,++print+eval$q,q,a,
        Yes = you want minimal number of operations?

        Do the diff arrays need to be ordered?

        Cheers Rolf
        (addicted to the Perl Programming Language and ☆☆☆☆ :)
        Je suis Charlie!

Re: Tree Structure Challenge
by LanX (Saint) on Nov 30, 2015 at 22:26 UTC
    Here the naive approach, no time to do the performant part now

    I didn't implement a class or objects, just array for leaves and a hash %parent for the parent relation.

    Cheers Rolf
    (addicted to the Perl Programming Language and ☆☆☆☆ :)
    Je suis Charlie!

      Yes, this seems to pass all my tests (after I made into the proper class). Congratz!

      And you used the same algorithm as I did (with almost the same variable names).

      And it's not Sunday yet!

      ($q=q:Sq=~/;[c](.)(.)/;chr(-||-|5+lengthSq)`"S|oS2"`map{chr |+ord }map{substrSq`S_+|`|}3E|-|`7**2-3:)=~y+S|`+$1,++print+eval$q,q,a,
        Great so if I don't need to produce an efficient version anymore, I can enjoy Sunday! =)

        Cheers Rolf
        (addicted to the Perl Programming Language and ☆☆☆☆ :)
        Je suis Charlie!

Re: Tree Structure Challenge
by Anonymous Monk on Nov 30, 2015 at 12:04 UTC
    Are we expected to write the module Zoo.pm while we are at it? Or am I missing something?
      If you can just write the diff method, you don't need to write anything else.
      ($q=q:Sq=~/;[c](.)(.)/;chr(-||-|5+lengthSq)`"S|oS2"`map{chr |+ord }map{substrSq`S_+|`|}3E|-|`7**2-3:)=~y+S|`+$1,++print+eval$q,q,a,

        Unless you want to test your code rather than just post code that you've never actually run.

        - tye        

        If diff needs to be based on Parent and get_leaves, I don't see how we can get around not writing those. So, we need to write the whole module.

        What is the assumed output of the constructor?

        Dum Spiro Spero
Re: Tree Structure Challenge
by grondilu (Friar) on Dec 02, 2015 at 16:04 UTC
      I was surprised when I noticed for the first time, too. BTW, you forgot to include your Perl6 solution :-)
      ($q=q:Sq=~/;[c](.)(.)/;chr(-||-|5+lengthSq)`"S|oS2"`map{chr |+ord }map{substrSq`S_+|`|}3E|-|`7**2-3:)=~y+S|`+$1,++print+eval$q,q,a,
      Well dinosaurs are reptiles, even modern one! ;-)

      Cheers Rolf
      (addicted to the Perl Programming Language and ☆☆☆☆ :)
      Je suis Charlie!

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlmeditation [id://1148837]
Approved by kcott
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others avoiding work at the Monastery: (4)
As of 2024-03-29 09:27 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found