[langage] perl script pour balancer un B-arbre

Bonjour à tous!,
Le modérateur GLDavid m'a vanté les avantages d'utiliser developper.com pour poser mes questions Je me suis donc inscrit suite à une recherche infructueuse sur le moteur Google :).

Je cherche un script en perl qui balance un arbre b-arbre selon la méthode AVL. il devrait recevoir en paramètre une référence vers un hash de array à 3 éléments (value, noeud gauche et droit)

j'ai cet algorithme en C , mais je voudrais la trouver écrite en perl, pour éviter de recoder ce que quelqu'un a sûrement déjà fait.

Par ailleurs, Je crois que ce site, relativement nouveau pour moi, pourra être une source de connaissance très très intéressante dans mes projets futurs.

Mes salutations à tous

RonMaster

Citation:

Envoyé par RonMaster

Le modérateur GLDavid m'a vanté les avantages d'utiliser developper.com

On parle de moi ??? :D Ah, si j'avais eu 1$ à chaque fois que j'ai vanté dvp.com...., je serais riche !!!
Bienvenue à toi.
Bien, n'oublies pas que developez.com ne t'apportera pas de scripts "tout prêts" (à moins que quelqu'un l'ait sous le coude.
Mais pas de problème, on fera de notre mieux pour t'aider.

@ ++

GLDavid, agent publicitaire de dvp.com et qui est quelques bureaux plus loin que celui de RonMaster 8)

Comme je le disais, cet algorithme a déjà été codé en perl. Si quelqu'un là et qui veut faire un cut and paste, se serait bien, sinon, c'est pas grave.

Salut Ron

Je t'ai trouvé cette fonction :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
 
sub bal_tree_find {
    my ($tree, $val, $cmp) = @_;
    my $result;
 
    while ( $tree ) {
        my $relation = defined $cmp
            ? $cmp->( $tree->{val}, $val )
		: $tree->{val} <=> $val;
 
        # Stop when the desired node is found.
        return $tree if $relation == 0;
 
        # Go down to the correct subtree.
        $tree = $relation < 0 ? $tree->{left} : $tree->{right};
    }
 
    # The desired node doesn't exist.
    return undef;
}

C'est la description de la méthode bal_tree_find utilisé dans le module btrees.
J'espère que ça t'aidera.

@ ++

script pour balancer un arbre binaire (final)

C'est fait, j'ait retranscrit mon algo de C en Perl. Et je me suis fait un plaisir de le debugger :lol: . Pour faire quelque chose de complet je vous retransmet une petite partie du code du livre Perl Cookbook première édition Chapitre 11 example binary trees.

Code:

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
 
#!/usr/bin/perl -w
# bintree - binary tree demo program
use strict;
use lib "entrer la path pour aller chercher la librairie B_arbre.pm";
use B_arbre;
my(%root, $n);
 
# first generate 20 random inserts
while ($n++ < 20) { &B_arbre::insert(\%root, int(rand(1000)))}
 
#on appelle la fonction de balance ici
&B_arbre::balance_arbre(\%root);
 
# now dump out the tree all three ways
print "Pre order:  ";  &B_arbre::pre_order(\%root);  print "\n";
print "In order:   ";  &B_arbre::in_order(\%root);   print "\n";
print "Post order: "; &B_arbre:: post_order(\%root); print "\n";
 
# prompt until EOF
for (print "Search? "; <>; print "Search? ") { 
    chomp;
    my $found = &B_arbre::search(\%root, $_);
    if ($found) { print "Found $_ at $found, $found->{VALUE}\n" }
    else        { print "No $_ in tree\n" }
}
 
exit;

Quand l'arbre est construit, on appelle ensuite le paquet suivant:
&B_arbre::balance_arbre($root);
voici le code du paquet B_arbre.pm

Code:

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
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
 
#!/usr/bin/perl
 use strict;
package B_arbre;
 
    # bintree - binary tree demo program use strict;
    my($root, $n);
 
    #########################################
 
    # insert given value into proper point of
    # provided tree.  If no tree provided, 
    # use implicit pass by reference aspect of @_
    # to fill one in for our caller.
    sub insert {
      my($tree, $value) = @_;
      unless (defined $tree->{VALUE}) {
        #$tree = {};		# allocate new node  si on met ca, on vient de perdre le pointeur original et le hash se réinitialise
        $tree->{VALUE}  = $value;
        $tree->{LEFT}   = undef;
        $tree->{RIGHT}  = undef;
        $_[0] = $tree;		# $_[0] is reference param!
        return;
    }
 
      if    ($tree->{VALUE} gt $value) { insert($tree->{LEFT},  $value) }
      elsif ($tree->{VALUE} lt $value) { insert($tree->{RIGHT}, $value) }
      else                            { warn "dup insert of $value\n"  }
      # XXX: no dups
}
 
    # recurse on left child, 
    # then show current value, 
    # then recurse on right child.
    sub in_order {
      my($tree) = @_;
      return unless $tree;
      in_order($tree->{LEFT});
      print $tree->{VALUE}, " ";
      in_order($tree->{RIGHT});
    }
 
    # show current value, 
    # then recurse on left child, 
    # then recurse on right child.
    sub pre_order {
      my($tree) = @_;
      return unless $tree;
      print $tree->{VALUE}, " ";
      pre_order($tree->{LEFT});
      pre_order($tree->{RIGHT});
    }
 
    # recurse on left child, 
    # then recurse on right child,
    # then show current value. 
    sub post_order {
      my($tree) = @_;
      return unless $tree;
      post_order($tree->{LEFT});
      post_order($tree->{RIGHT});
      print $tree->{VALUE}, " ";
    }
 
    # find out whether provided value is in the tree.
    # if so, return the node at which the value was found.
    # cut down search time by only looking in the correct
    # branch, based on current value.
    sub search {
      my($tree, $value) = @_;
      return unless ($tree);
      $value =~ s/[\)\(\[]//g;
      if ($tree->{VALUE} =~ /$value\s*/) {
        return $tree;
      }
      search($tree->{ ($value lt $tree->{VALUE}) ? "LEFT" : "RIGHT"}, $value)
      }
#trouve et renvoie le maximum de deux nombres entiers
sub maximum
{
    my ($i,$j) = @_;
    my $max;
    if($i <= $j)
    {
	$max = $j;
    }
    else
    {
	$max = $i;
    }
    return $max;
}
 
#Trouve  la hauteur d'un noeud
#reçoit en parametre la reference d'un noeud
sub hauteur
{
    my $tree = shift @_;
    return -1 unless ($tree);
    if(!(exists($tree->{LEFT})) && !(exists($tree->{RIGHT}))) {return 0;}
    if(!(exists($tree->{LEFT})) && exists($tree->{RIGHT})) {return 1 + &hauteur($tree->{RIGHT});}
    if(exists($tree->{LEFT}) && !(exists($tree->{RIGHT}))) {return 1 + &hauteur($tree->{LEFT});}
    else
    {
	return 1 + &maximum(&hauteur($tree->{RIGHT}),&hauteur($tree->{LEFT}));
    }
}
 
#Faire une rotation simple de l'arbre vers la droite
sub zig_zig_droite
{
    my $noeud = shift @_;
    my $temp = $noeud->{RIGHT};
    $noeud->{RIGHT} = $temp->{LEFT};
    $temp->{LEFT} = $noeud;
    $noeud = $temp;
    return $noeud;
}
 
#Faire une rotation simple de l'arbre vers la gauche
sub zig_zig_gauche
{
    my $noeud = shift @_;
    my $temp = $noeud->{LEFT};
    $noeud->{LEFT} = $temp->{RIGHT};
    $temp->{RIGHT} = $noeud;
    $noeud = $temp;
    return $noeud;
}
 
#Faire une rotation double de l'arbre vers la droite
sub zig_zag_droit
{
    my $noeud = shift @_;
    $noeud->{RIGHT} = zig_zig_gauche($noeud->{RIGHT});
    $noeud = zig_zig_droite($noeud);
    return $noeud;
}
 
#Faire une rotation double de l'arbre vers la gauche
sub zig_zag_gauche
{
    my $noeud = shift @_;
    $noeud->{LEFT} = zig_zig_droite($noeud->{LEFT});
    $noeud = zig_zig_gauche($noeud);
    return $noeud;
}
 
#fonction qui equilibre un arbre binaire
sub balance_arbre
{
    my $noeud = shift @_;
    my $noeud2;
 
    return $noeud unless ($noeud);
    if(&hauteur($noeud->{LEFT}) - &hauteur($noeud->{RIGHT}) == 2)
    {
	print "if 1_1\n";
	if(&hauteur($noeud->{LEFT}->{LEFT}) - &hauteur($noeud->{LEFT}->{RIGHT}) == 1)
	{
	print "if 1_2\n";
	    $noeud2 = zig_zig_gauche($noeud);
	    $noeud = $noeud2;
	}
	if(&hauteur($noeud->{LEFT}->{LEFT}) - &hauteur($noeud->{LEFT}->{RIGHT}) == -1)
	{
	print "if 1_3\n";
	    $noeud2 = zig_zag_gauche($noeud);
	    $noeud = $noeud2;
	}
    }
     if(&hauteur($noeud->{RIGHT}) - &hauteur($noeud->{LEFT}) == -2)
    {
	print "if 2_1\n";
	if(&hauteur($noeud->{LEFT}->{LEFT}) - &hauteur($noeud->{LEFT}->{RIGHT}) == -1)
	{
	print "if 2_2\n";
	    $noeud2 = zig_zig_droite($noeud);
	    $noeud = $noeud2;
	}
	if(&hauteur($noeud->{LEFT}->{LEFT}) - &hauteur($noeud->{LEFT}->{RIGHT}) == 1)
	{
	print "if 2_3\n";
	    $noeud2 = zig_zag_droite($noeud);
	    $noeud = $noeud2;
	}
    }
    return $noeud;
}
 
1;

Excellent !
Approuvé même !
Forumeurs, nous avons trouvé notre forestier binaire !

@ ++