RabbitFarm

The examples used here are from The Weekly Challenge problem statement and demonstrate the working solution.

Part 1

You are given an array of positive integers, such that all the numbers appear even number of times except one number. Write a script to find that integer.

Solution

use strict;
use warnings;
sub find_odd_occurring{
    my %counts;
    for my $x (@_){
        $counts{$x}++;
    }
    for my $x (keys %counts){
        return $x if $counts{$x} % 2 != 0;
    }
}

MAIN:{
    print find_odd_occurring(2, 5, 4, 4, 5, 5, 2) . "\n";
    print find_odd_occurring(1, 2, 3, 4, 3, 2, 1, 4, 4) . "\n";
}

Sample Run

$ perl perl/ch-1.pl
5
4

Notes

I spent some time thinking if this could be done without two passes over the numbers. I do not think that is possible, since we have no limits on the off or even occurrences. For example, we could short circuit the checking if we knew that there might on be, say, three occurrences of the odd number. But here we have no such limitations and so we must tally all numbers in the list and then check to see which has an odd number of occurrences.

Part 2

You are given a tree. Write a script to find out if the given tree is Binary Search Tree (BST).

Solution

use strict;
use warnings;
package Tree130{
    use boolean;      
    use Class::Struct; 

    use constant LEFT => 0;
    use constant RIGHT => 1;

    package Node{
        use boolean;  
        use Class::Struct; 
        struct(
            value => q/$/,
            left => q/Node/,
            right => q/Node/
        );  
        true; 
    }  

    struct(
        root => q/Node/,
        nodes => q/@/
    );   

    sub print_tree{ 
        my($self) = @_;   
        my $left_child = $self->root()->left();
        my $right_child = $self->root()->right();
        print $self->root()->value() . " -> " . $left_child->value() . "\n" if $left_child;
        print $self->root()->value() . " -> " . $right_child->value() . "\n" if $right_child;
        print_tree_r($left_child);
        print_tree_r($right_child);
    }  

    sub print_tree_r{ 
        my($node) = @_;   
        my $left_child = $node->left();
        my $right_child = $node->right();
        print $node->value() . " -> " . $left_child->value() . "\n" if $left_child;
        print $node->value() . " -> " . $right_child->value() . "\n" if $right_child;
        print_tree_r($left_child) if $left_child;
        print_tree_r($right_child) if $right_child;
    } 

    sub min_tree_value{
        my($node) = @_; 
        my $left_child = $node->left();
        my $right_child = $node->right();
        return $node->value() if !$left_child && !$right_child;
        return [sort {$a <=> $b} ($node->value(), min_tree_value($left_child), min_tree_value($right_child))]->[0];
    }

    sub max_tree_value{
        my($node) = @_;   
        my $left_child = $node->left();
        my $right_child = $node->right();
        return $node->value() if !$left_child && !$right_child;
        return [sort {$a <=> $b} ($node->value(), max_tree_value($left_child), max_tree_value($right_child))]->[2];
    }

    sub is_bst{
        my($self, $node) = @_;
        return true if !$node;
        my $left_child = $node->left();
        my $right_child = $node->right();
        return false if $left_child && $node->value < max_tree_value($left_child);    
        return false if $right_child && $node->value > min_tree_value($right_child);   
        return false if !$self->is_bst($left_child) || !$self->is_bst($right_child);
        return true;    
    }

    sub insert{
        my($self, $source, $target, $left_right) = @_;   
        if(!$self->root()){      
            $self->root(new Node(value => $source));   
            push @{$self->nodes()},  $self->root();      
        }   
        my $source_node = [grep {$_->value() == $source} @{$self->nodes()}]->[0];
        my $target_node = new Node(value => $target);
        if($source_node){
            $source_node->left($target_node) if $left_right == LEFT;
            $source_node->right($target_node) if $left_right == RIGHT;
            push @{$self->nodes()}, $target_node;
        }
    }  
    true; 
}

package main{
    use constant LEFT => 0;
    use constant RIGHT => 1;

    my $tree = new Tree130(); 
    $tree->insert(8, 5, LEFT); 
    $tree->insert(8, 9, RIGHT); 
    $tree->insert(5, 4, LEFT); 
    $tree->insert(5, 6, RIGHT); 
    print $tree->is_bst($tree->root()) . "\n";
    $tree = new Tree130(); 
    $tree->insert(5, 4, LEFT); 
    $tree->insert(5, 7, RIGHT); 
    $tree->insert(4, 3, LEFT); 
    $tree->insert(4, 6, RIGHT); 
    print $tree->is_bst($tree->root()) . "\n";
} 

Sample Run

$ perl perl/ch-2.pl
1
0

Notes

All my code, for the time being at least, has converged on a pretty standard approach using Class::Struct. I have done this enough recently where I've convinced myself this is the best for several reasons

• This allows for object oriented construction of the data structure with almost the minimum overhead
• While providing for some OO structure, other than generating default accessor methods there is not too much done behind the scenes. Organizing the code this way does not feel like "cheating" in that there is any reliance on the OO framework, since it is so minimal.
• Many classic texts on data structures use C and that languages struct ability. Some superficial resemblance to that code is helpful in translating examples from the literature to Perl.

The first issue to deal with this part of the challenge is to construct a Binary Tree, but not do any sort of balancing when performing insertions into the tree. To do this I made a simple insert function which takes a source and target node and a third parameter which dictates whether the target is to be the left or right child of the source. In this way we can easily construct a broken binary tree.

Actually verifying whether the tree is a proper BST follows fairly directly from the definition of a Binary Tree. For each node, including the root, we check to see if the largest value to the left is smaller as well as the minimum value to the right being larger.

References

Challenge 130

Class::Struct

Binary Trees