substr과 재귀호출 vs 정규표현식 벤치마크

tree.pl

#!/usr/bin/env perl
use strict;
use warnings;
use Benchmark qw/:all/;

# 입력 (A,(B,(D,(d,_,_),_),(E,_,_)),(C,(F,_,(f,_,_)),(G,(g,_,_),_)))
# 위 입력을 받아 A를 root로 하는 트리 구조를 구성
#
#       G
#          g
#    C
#          f
#       F
# A
#       E
#    B
#       D
#          d
#
# construct_node_recursive
# substr()과 재귀호출을 써서 스트링을 앞에서부터 읽어나가며 구성
#
# construct_node_regexp
# 정규표현식으로 (A,_,_) 형태를 읽고 노드를 만들고 배열에 저장한 후
# 스트링의 그 자리를 배열 인덱스로 치환하는 과정을 반복

# 트리 출력용
sub print_tree { #{{{
    my ($p, $c) = @_;

    if ( not defined $p ) {
        return;
    }

    print_tree( $p->{right}, $c + 3 );
    print " "x$c, $p->{data}, "\n";
    print_tree( $p->{left},  $c + 3 );

    return;
} #}}}

sub construct_node_recursive { #{{{
    my $s = shift;
    my $i = 0;

    if ( substr($s, $i, 1) ne "(" ) {
        die "error 1: [" . substr($s, $i, 1). "]";
    }

    $i += 1;

    my $node = {
                    data => substr($s, $i, 1),
                    left => undef,
                    right => undef,
    };

    $i += 2;

    if ( substr($s, $i, 1) ne "_" ) {
        ( $node->{left}, my $i_inc ) = construct_node_recursive( substr($s, $i) );
        $i += $i_inc;
    }

    $i += 2;

    if ( substr($s, $i, 1) ne "_" ) {
        ( $node->{right}, my $i_inc ) = construct_node_recursive( substr($s, $i) );
        $i += $i_inc;
    }

    $i += 1;
    if ( substr($s, $i, 1) ne ")" ) {
        die "error 2: [" . substr($s, $i, 1). "]";
    }

    return ( $node, $i );
} #}}}

sub construct_node_regexp { #{{{
    my $str = shift;

    my @nodes = ();
    my $make_node = sub {
        my ( $data, $left, $right ) = @_;
        my $node = { data => $data };
        $node->{left} = $left eq "_" ? undef : $nodes[$left];
        $node->{right} = $right eq "_" ? undef : $nodes[$right];

        push @nodes, $node;
        return $#nodes;
    };

    while ( $str =~ s/\(
                        (\w)
                        ,
                        (_|\d+)
                        ,
                        (_|\d+)
                       \)/$make_node->($1, $2, $3)/xge ) { }

    return $nodes[$str];
} #}}}

sub main {
    my $str = "(A,_,_)";
    $str = "(A,(B,_,_),_)";
    $str = "(A,_,(C,_,_))";
    $str = "(A,(B,_,_),(C,_,_))";
    $str = "(A,(B,(D,(d,_,_),_),(E,_,_)),(C,(F,_,(f,_,_)),(G,(g,_,_),_)))";

    my $root = undef;

    ($root) = construct_node_recursive( $str );
    print_tree($root, 0);

    print "-"x30, "\n";
    ($root) = construct_node_regexp( $str );
    print_tree($root, 0);
}

main();


# 벤치마크
my $str = "(A,(B,(D,(d,_,_),_),(E,_,_)),(C,(F,_,(f,_,_)),(G,(g,_,_),_)))";
cmpthese(
    timethese( -5, {
        recursive => sub { construct_node_recursive( $str ) },
        regexp    => sub { construct_node_regexp( $str ) },
    }
    )
);

$ ./tree.pl
      G
         g
   C
         f
      F
A
      E
   B
      D
         d
------------------------------
      G
         g
   C
         f
      F
A
      E
   B
      D
         d
Benchmark: running recursive, regexp for at least 5 CPU seconds...
 recursive:  5 wallclock secs ( 5.22 usr +  0.00 sys =  5.22 CPU) @ 22669.16/s (n=118333)
    regexp:  5 wallclock secs ( 5.33 usr +  0.00 sys =  5.33 CPU) @ 13072.98/s (n=69679)
             Rate    regexp recursive
regexp    13073/s        --      -42%
recursive 22669/s       73%        --