Thread eine Frage zu objektorientertem Perl (149 answers)
Opened by ASDS at 2007-04-10 15:14

Ronnie
 2007-04-12 18:15
#75841 #75841
User since
2003-08-14
2022 Artikel
BenutzerIn
[default_avatar]
Hier mal ein kleines Beispiel wie so ein Baum funktionieren könnte. Aus Bequemlichkeit verwende ich CPAN:Moose und CPAN:overload.
Code: (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
#!/usr/bin/perl

use strict;
use warnings;

package LispTree;
use Moose;
use overload '""' => \&to_s;

has 'op'    => ( is => 'ro' );
has 'l'     => ( is => 'rw' );
has 'r'     => ( is => 'rw' );

sub to_s {
    my $self = shift;
    my $o  = '(' . $self->op . ' ';
       $o .= ref $self->l ? $self->{l}->to_s : $self->l;
       $o .= ' ';
       $o .= ref $self->r ? $self->{r}->to_s : $self->r;
       $o .= ')';
    return $o;
}

package main;

my $root = LispTree->new( op => '+' );
$root->l(12);

my $leaf = LispTree->new( op => '*', l => 15, r => 2 ); 
$root->r($leaf);

print $root . "\n";

EDIT1: Alternativ nochmal mit einer anderen Traversierung des Baums:
Code: (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
#!/usr/bin/perl

use strict;
use warnings;

package LispTree;
use Moose;
use overload '""' => \&to_s;

has 'op'    => ( is => 'ro' );
has 'l'     => ( is => 'rw' );
has 'r'     => ( is => 'rw' );

sub to_s {
    my $self = shift;
    my $o  = '(' . $self->op . ' ';
       $o .= ref $self->l ? $self->{l}->to_s : $self->l;
       $o .= ' ';
       $o .= ref $self->r ? $self->{r}->to_s : $self->r;
       $o .= ')';
    return $o;
}

sub to_rpn {
    my $self = shift;
    my $o  = ref $self->l ? $self->{l}->to_rpn : $self->l;
       $o .= ' ';
       $o .= ref $self->r ? $self->{r}->to_rpn : $self->r;
       $o .= ' ' . $self->op;
    return $o;
}

package main;

my $root = LispTree->new( op => '+' );
$root->l(LispTree->new( op => '+', l => 6, r => 6 ));

my $leaf = LispTree->new( op => '*', l => 15, r => 2 ); 
$root->r($leaf);

print $root->to_rpn . "\n";

EDIT2: Jetzt auch mal mit der Möglichkeit der Berechnung:
Code: (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
#!/usr/bin/perl

use strict;
use warnings;

package LispTree;
use Moose;
use overload '""' => \&to_s;

has 'op'    => ( is => 'ro' );
has 'l'     => ( is => 'rw' );
has 'r'     => ( is => 'rw' );

my $operations = {
    '*' => sub { $_[0] * $_[1] },
    '+' => sub { $_[0] + $_[1] },
    '/' => sub { $_[0] / $_[1] },
    '-' => sub { $_[0] - $_[1] },
};

sub to_s {
    my $self = shift;
    my $o  = '(' . $self->op . ' ';
       $o .= blessed $self->l ? $self->{l}->to_s : $self->l;
       $o .= ' ';             
       $o .= blessed $self->r ? $self->{r}->to_s : $self->r;
       $o .= ')';             
    return $o;                
}                             
                              
sub to_rpn {                  
    my $self = shift;         
    my $o  = blessed $self->l ? $self->{l}->to_rpn : $self->l;
       $o .= ' ';             
       $o .= blessed $self->r ? $self->{r}->to_rpn : $self->r;
       $o .= ' ' . $self->op;
    return $o;
}

sub calc {
    my $self = shift;
    my $l = blessed $self->l ? $self->{l}->calc : $self->l;
    my $r = blessed $self->r ? $self->{r}->calc : $self->r;
    return $operations->{$self->op}->( $l, $r );
}

package main;

my $root = LispTree->new( op => '+' );
$root->l(LispTree->new( op => '+', l => 6, r => 6 ));

my $leaf = LispTree->new( op => '*', l => 15, r => 2 ); 
$root->r($leaf);

print $root . "\n" x 2 . $root->to_rpn . "\n" . $root->calc . "\n";
\n\n

<!--EDIT|Ronnie|1176399727-->

View full thread eine Frage zu objektorientertem Perl