re: Daily Coding Problem #3 VIEW POST

FULL DISCUSSION
 

The tricky part is to make it work for arbitrary values, i.e. drop the assumption the symbols for Empty_Marker and '-' are not going to be used in any node's value.

Here's such a solution in Perl, tests included:

#!/usr/bin/perl
use warnings;
use strict;

package Node {
    use Moo;

    has value => (is => 'ro', required => 1);
    has left  => (is => 'ro', isa => sub { shift->isa('Node') or die });
    has right => (is => 'ro', isa => sub { shift->isa('Node') or die });

    my $_escape_value = sub {
        my ($self) = @_;
        my $value = $self->value;
        $value =~ s/$_->[0]/\\$_->[1]/g
            for [qr/\\/ => '\\'],
                [qr/"/  => '\''],
                [qr/\(/ => '['],
                [qr/\)/ => ']'];

        return $value
    };

    my $unescape = sub {
        my ($value) = @_;

        $value =~ s/(?<!\\)\\$_->[0]/$_->[1]/g
            for [qr/\]/ => ')'],
                [qr/\[/ => '('],
                [qr/'/  => '"'];
        $value =~ s/\\\\/\\/g;

        return $value
    };

    my $parse = sub {
        my ($rest) = @_;
        my $pos = '(' eq substr $rest, 0, 1;
        my $rank = $pos;
        until (0 == $rank) {
            ++$rank if '(' eq substr $rest, $pos, 1;
            --$rank if ')' eq substr $rest, $pos, 1;
            ++$pos;
        }

        my $left  = substr $rest, 0, $pos;
        my $right = substr $rest, $pos + ($pos != length $rest);

        length $_ and $_  = __PACKAGE__->deserialize($_)
            for $left, $right;

        return $left, $right
    };

    sub serialize {
        my ($self) = @_;

        my $value = $self->$_escape_value;
        my ($left, $right) = map $_ ? $_->serialize : "",
                                 $self->left,
                                 $self->right;

        return '(' . join(',', qq("$value"), $left, $right) . ')'
    }

    sub deserialize {
        my ($class, $string) = @_;

        return undef unless length $string;

        my ($value, $rest) = $string =~ /^\("([^"]*)",(.*)\)$/sg;

        $value = $unescape->($value);
        my ($left, $right) = $parse->($rest);

        return $class->new(value => $value,
                           (left  => $left)  x !! ref $left,
                           (right => $right) x !! ref $right)
    }

};

use Test::More tests => 7;

my $node1 = 'Node'->new(
    value => 'root',
    left  => 'Node'->new(
        value => 'left',
        left => 'Node'->new(value => my $left_left = 'left.left')),
    right => 'Node'->new(value => 'right'),
);

is 'Node'->deserialize($node1->serialize)->left->left->value, $left_left;

my $node2 = 'Node'->new(
    value => my $empty = "",
    right => 'Node'->new(value => my $special_chars = '("[,\'\\]"))',
                         right => 'Node'->new(
                             value => my $newline = "1\n2")));

is 'Node'->deserialize($node2->serialize)->value,
    $empty;
is 'Node'->deserialize($node2->serialize)->right->value,
    $special_chars;
is 'Node'->deserialize($node2->serialize)->right->right->value,
    $newline;

my $node3 = 'Node'->new(value => $node1->serialize,
                        left  => 'Node'->new(value => $node2->serialize));

is 'Node'->deserialize($node3->serialize)->value,
    $node1->serialize;
is 'Node'->deserialize($node3->serialize)->left->value,
    $node2->serialize;

my $super = $node3->serialize;

$super = 'Node'->new(
    value => 'Node'->deserialize($super)->serialize
)->serialize
    for 1 .. 6;

my $root = $super;
$root = 'Node'->deserialize($root)->value for 1 .. 8;
is $root, 'root';
code of conduct - report abuse