Discussion :

[djibril]

Bonsoir,

Cette fois, je pose une question car j'ai un petit problème à résoudre.
Je dois refaire la numérotation de sommaires (contenu dans des fichiers XML) en fonction de certains critères.

Les XML importent peu, je vais vous montrer un exemple.

Je vais vous représenter un sommaire sous forme de hash (issu d'un parsing), on verra si c'est la bonne solution car on perd l'ordre.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
my %sommaire = (
	'1*' => { '1-a',  '1-b', },
	'2'  => { '2-a*', '2-b' => { '2-b-A', '2-b-B' '2-b-C' }, },
	'3*' => { '3-a',  '3-b', },
	'4'  => { '4-a',  '4-b', },
);

En gros, on a quatre chapitres numérotés de 1 à 4 (ça aurait pu être de A à D).
Le chapitre 1 a deux sous-chapitres 1-a et 1-b et ainsi de suite.

Vous constatez dans certains cas que nous avons des étoiles (*).
Cela signifie que dans notre nouveau sommaire, ces chapitres (et sous chapitres) ne devront plus compter dans la numérotation. On rajoutera un préfixe 0- afin de les isoler de façon unique. Il faut donc reclaculer le sommaire.
Notre sommaire devrait devenir le suivant :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
my %sommaire_final = (
	'0-1*' => { '0-1-a',  '0-1-b', },
	'1'    => { '0-1-a*', '1-a' => { '1-a-A', '1-a-B' '1-a-C' }, },
	'0-3*' => { '0-3-a',  '0-3-b', },
	'2'    => { '2-a',    '2-b', },
);

En constate que le chapitre 4 et devenu chapitre 2, que le chapitre 2-b-A est devenu 1-a-A...
Les autres avec étoiles ont été renommés.

Ma problématique est donc de trouver une solution à ce problème quelque soit le placement des étoiles.
De plus, je dois être capable de faire la correspondance entre chaque ancien et nouveau chapitre afin d'effectuer les changement.

• 2-b-A devient 1-a-A ;
• 2 devient 1 ;
• 4 devient 2 ;
• ...

N.B. La numérotation d'un sommaire peut-être 1, i, I, a ou A. Et on peut avoir plusieurs niveaux sans limite. Dans l'exemple ci-dessus, il y a trois niveaux.

Toute aide est la bienvenue !

[Lolo78]

Hum, j'ai peut-être une petite idée, mais je ne suis pas sûr de bien comprendre.

Ton sommaire de base:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
my %sommaire = (
	'1*' => { '1-a',  '1-b', },
	'2'  => { '2-a*', '2-b' => { '2-b-A', '2-b-B' '2-b-C' }, },
	'3*' => { '3-a',  '3-b', },
	'4'  => { '4-a',  '4-b', },
);

Je comprends que tu veux supprimer le chapitre 1. Mais pas bien ce que doivent devenir les sous-chapitres 1-a et 1-b (je suppose qu'ils doivent subsister, mais sous quelle numérotation?). De même, si 1 disparaît, 2 est-il renommé?

[cmcmc]

Bonjour djibril,

tes hashes ont l'air plutôt malades

Quoi qu'il en soit on n'en a pas besoin car il y a une hiérarchie implicite qui suffit à structurer le problème.

Ci-dessous une version limitée (0-9, a-z, A-Z, pas de chiffres romains) pour illustrer le principe général.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
# sommaire1.pl
use strict;
use warnings;
use 5.010;
 
my @sections = qw(2-b-B 2-b-C 3* 3-a 3-b 4 4-a 4-b 1* 1-a 1-b 2 2-a* 2-b 2-b-A);
 
my (@d, %k, %p) = map { ord($_) - 1 } qw(1 a A);
say +(q{  } x split q{-}), qq{$_ (ex $p{$_})} for map {
    ++$d[my $n = -1 + split q{-}];
    $p{my $x = join q{-}, map chr, @d[0 .. $n]} = $_;
    $x;
} grep { 
    my ($b, $p, $m) = m/^((?:(.*)-)?.*?)([*])?$/;
    !$m and (!$p or $k{$p}) and ++$k{$b} and $b
} sort @sections;

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Taisha:~/tttmp/sommaire $ perl sommaire1.pl
  1 (ex 2)
    1-a (ex 2-b)
      1-a-A (ex 2-b-A)
      1-a-B (ex 2-b-B)
      1-a-C (ex 2-b-C)
  2 (ex 4)
    2-b (ex 4-a)
    2-c (ex 4-b)
Taisha:~/tttmp/sommaire $

Le sort est essentiel. Le grep fait la sélection, le map le renommage.

[Philou67430]

J'adore ce genre de petit défit

Je suis parti sur un algorithme qui ne suppose rien sur la manière dont la numérotation à chaque niveau s'incrémente, dès lors que l'on peut considérer que dans le nouveau sommaire, tous les numéros de chaque niveau sont des numéros qui existent déjà dans le sommaire actuel, et qu'il suffit "de les décaler", "de les préfixer" ou "d'en modifier le préfixe avec des valeurs connues".

Voici le programme, qui semble faire ce que Djibril souhaite :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
#!/usr/bin/perl
 
use strict;
use warnings;
use feature qw(:5.14);
 
use Data::Dumper;
$Data::Dumper::Sortkeys++;
 
my $sommaire = {
	'1*' => { '1-a' => undef,  '1-b' => undef, },
	'2'  => { '2-a*' => undef, '2-b' => { '2-b-A' => undef, '2-b-B' => undef, '2-b-C' => undef }, },
	'3*' => { '3-a' => undef,  '3-b' => undef, },
	'4'  => { '4-a' => undef,  '4-b' => undef, },
};
 
say Data::Dumper->Dump([$sommaire], [qw($sommaire)]);
 
sub update_level($;@);
sub update_level($;@) {
  my ($s, @changes) = @_;
 
  my $new_s = { };
  return undef if !defined $s;
 
  my @level;
  foreach my $num (sort keys %$s) {
    my $sub_level = $s->{$num};
    foreach my $change (@changes) {
      my ($old, $new) = @$change;
      $num =~ s/^$old/$new/;
    }
    my $to_remove = $num =~ s/\*$//;
    push @level, $num;
    if ($to_remove) {
      $new_s->{"0-$num"} = update_level($sub_level, @changes, [ $num, "0-$num" ]);
    }
    else {
      my $current_num = shift @level;
      $new_s->{$current_num} = update_level($sub_level, @changes, [ $num, $current_num ]);
    }
  }
 
  return $new_s;
}
 
my $new_sommaire = update_level($sommaire);
 
say Data::Dumper->Dump([$new_sommaire], [qw(*new_sommaire)]);

[djibril]

Hum, j'ai peut-être une petite idée, mais je ne suis pas sûr de bien comprendre.

Ton sommaire de base:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
my %sommaire = (
	'1*' => { '1-a',  '1-b', },
	'2'  => { '2-a*', '2-b' => { '2-b-A', '2-b-B' '2-b-C' }, },
	'3*' => { '3-a',  '3-b', },
	'4'  => { '4-a',  '4-b', },
);

Je comprends que tu veux supprimer le chapitre 1. Mais pas bien ce que doivent devenir les sous-chapitres 1-a et 1-b (je suppose qu'ils doivent subsister, mais sous quelle numérotation?). De même, si 1 disparaît, 2 est-il renommé?

En fait, je ne souhaite pas supprimer le chapitre 1 et 4, mais les cacher. Donc à mon sens, cacher veut dire les exclure de ma numérotation et ceux en rajoutant un préfix (car chaque numérotation doit être unique).
Un chapitre étoilé veut dire toute sa descendance étoilée.

Ensuite, je dois recalculer les autres chapitres et sous-chapitres.

Au final, je pourrais renommer tout mon sommaire avec mon résultat final.

[djibril]

Bonjour djibril,

tes hashes ont l'air plutôt malades

Quoi qu'il en soit on n'en a pas besoin car il y a une hiérarchie implicite qui suffit à structurer le problème.

Ci-dessous une version limitée (0-9, a-z, A-Z, pas de chiffres romains) pour illustrer le principe général.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
# sommaire1.pl
use strict;
use warnings;
use 5.010;
 
my @sections = qw(2-b-B 2-b-C 3* 3-a 3-b 4 4-a 4-b 1* 1-a 1-b 2 2-a* 2-b 2-b-A);
 
my (@d, %k, %p) = map { ord($_) - 1 } qw(1 a A);
say +(q{  } x split q{-}), qq{$_ (ex $p{$_})} for map {
    ++$d[my $n = -1 + split q{-}];
    $p{my $x = join q{-}, map chr, @d[0 .. $n]} = $_;
    $x;
} grep { 
    my ($b, $p, $m) = m/^((?:(.*)-)?.*?)([*])?$/;
    !$m and (!$p or $k{$p}) and ++$k{$b} and $b
} sort @sections;

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Taisha:~/tttmp/sommaire $ perl sommaire1.pl
  1 (ex 2)
    1-a (ex 2-b)
      1-a-A (ex 2-b-A)
      1-a-B (ex 2-b-B)
      1-a-C (ex 2-b-C)
  2 (ex 4)
    2-b (ex 4-a)
    2-c (ex 4-b)
Taisha:~/tttmp/sommaire $

Le sort est essentiel. Le grep fait la sélection, le map le renommage.

En quoi mon sommaire est malade ?
Les chapitres de niveau 1 sont des chiffres ou nombres.
Les chapitres de niveau 2 des lettres en minuscule (d'où 1-a, 1-b...)
Les chapitres de niveau 3 des lettres majuscule (d'où 2-b-A, 2-b-B...)

Tout est logique !

[djibril]

J'adore ce genre de petit défit

Je suis parti sur un algorithme qui ne suppose rien sur la manière dont la numérotation à chaque niveau s'incrémente, dès lors que l'on peut considérer que dans le nouveau sommaire, tous les numéros de chaque niveau sont des numéros qui existent déjà dans le sommaire actuel, et qu'il suffit "de les décaler", "de les préfixer" ou "d'en modifier le préfixe avec des valeurs connues".

Voici le programme, qui semble faire ce que Djibril souhaite :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
#!/usr/bin/perl
 
use strict;
use warnings;
use feature qw(:5.14);
 
use Data::Dumper;
$Data::Dumper::Sortkeys++;
 
my $sommaire = {
	'1*' => { '1-a' => undef,  '1-b' => undef, },
	'2'  => { '2-a*' => undef, '2-b' => { '2-b-A' => undef, '2-b-B' => undef, '2-b-C' => undef }, },
	'3*' => { '3-a' => undef,  '3-b' => undef, },
	'4'  => { '4-a' => undef,  '4-b' => undef, },
};
 
say Data::Dumper->Dump([$sommaire], [qw($sommaire)]);
 
sub update_level($;@);
sub update_level($;@) {
  my ($s, @changes) = @_;
 
  my $new_s = { };
  return undef if !defined $s;
 
  my @level;
  foreach my $num (sort keys %$s) {
    my $sub_level = $s->{$num};
    foreach my $change (@changes) {
      my ($old, $new) = @$change;
      $num =~ s/^$old/$new/;
    }
    my $to_remove = $num =~ s/\*$//;
    push @level, $num;
    if ($to_remove) {
      $new_s->{"0-$num"} = update_level($sub_level, @changes, [ $num, "0-$num" ]);
    }
    else {
      my $current_num = shift @level;
      $new_s->{$current_num} = update_level($sub_level, @changes, [ $num, $current_num ]);
    }
  }
 
  return $new_s;
}
 
my $new_sommaire = update_level($sommaire);
 
say Data::Dumper->Dump([$new_sommaire], [qw(*new_sommaire)]);

@philou, j'ai testé ton programme et il y a un petit souci.
Le nouvelle hash est parfait. LE seul bémol, est que je suis incapable de faire la liaison entre les anciennes et nouvelles numérotations. Je m'explique.

• 1* est devenu 0-1
• 2 est devenu 1
• 2-b-B est devenu 1-a-B
• 3* est devenu 2
• 4 est devenu 2
• ...

Comment je fais les correspondances ?

[cmcmc]

En quoi mon sommaire est malade ?
Les chapitres de niveau 1 sont des chiffres ou nombres.
Les chapitres de niveau 2 des lettres en minuscule (d'où 1-a, 1-b...)
Les chapitres de niveau 3 des lettres majuscule (d'où 2-b-A, 2-b-B...)

Tout est logique !

C'est peut-être logique mais ce n'est pas un hash Perl bien formé. Il manque une virgule entre '2-b-B' et '2-b-C', mais même avec ça ...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Taisha:~/tttmp/sommaire $ cat aie.pl 
my %sommaire = (
	'1*' => { '1-a',  '1-b', },
	'2'  => { '2-a*', '2-b' => { '2-b-A', '2-b-B', '2-b-C' }, },
	'3*' => { '3-a',  '3-b', },
	'4'  => { '4-a',  '4-b', },
);
use Data::Dumper;
print Dumper(\%sommaire);
Taisha:~/tttmp/sommaire $ perl aie.pl 
$VAR1 = {
          '2' => {
                   '2-a*' => '2-b',
                   'HASH(0x96d4dc)' => undef
                 },
          '1*' => {
                    '1-a' => '1-b'
                  },
          '3*' => {
                    '3-a' => '3-b'
                  },
          '4' => {
                   '4-a' => '4-b'
                 }
        };
Taisha:~/tttmp/sommaire $

Ce serait mieux de démarrer avec une structure de donnée saine, non ?

Ou bien de la jeter carrément car comme je l'ai montré on n'en a pas besoin, la liste des numéros de chapitres/sections etc. suffit.

[djibril]

Ah ok, je vois !
Faut reprendre la structure de philou, ou bien partir d'autre chose si tu veux. C'était surtout pour expliquer la hiérarchie du sommaire.

Pour mon programme je remplirais ce hash ou tableau comme ça vous arrange.

[Philou67430]

Sous quelle forme souhaites-tu que la correspondance soit faite ???
Une solution pourrait être de mettre l'ancienne numérotation entre paranthèse :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
#!/usr/bin/perl
 
use strict;
use warnings;
use feature qw(:5.14);
 
use Data::Dumper;
$Data::Dumper::Sortkeys++;
 
my $sommaire = {
	'1*' => { '1-a' => undef,  '1-b' => undef, },
	'2'  => { '2-a*' => undef, '2-b' => { '2-b-A' => undef, '2-b-B' => undef, '2-b-C' => undef }, },
	'3*' => { '3-a' => undef,  '3-b' => undef, },
	'4'  => { '4-a' => undef,  '4-b' => undef, },
};
 
say Data::Dumper->Dump([$sommaire], [qw($sommaire)]);
 
sub update_level($;@);
sub update_level($;@) {
  my ($s, @changes) = @_;
 
  my $new_s = { };
  return undef if !defined $s;
 
  my @level;
  foreach my $num (sort keys %$s) {
    my $old_num = $num;
    my $sub_level = $s->{$num};
    foreach my $change (@changes) {
      my ($old, $new) = @$change;
      $num =~ s/^$old/$new/;
    }
    my $to_remove = $num =~ s/\*$//;
    push @level, $num;
    if ($to_remove) {
      $new_s->{"0-$num ($old_num)"} = update_level($sub_level, @changes, [ $num, "0-$num" ]);
    }
    else {
      my $current_num = shift @level;
      $new_s->{"$current_num ($old_num)"} = update_level($sub_level, @changes, [ $num, $current_num ]);
    }
  }
 
  return $new_s;
}
 
my $new_sommaire = update_level($sommaire);
 
say Data::Dumper->Dump([$new_sommaire], [qw(*new_sommaire)]);

Résultat :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
%new_sommaire = (
                  '0-1 (1*)' => {
                                  '0-1-a (1-a)' => undef,
                                  '0-1-b (1-b)' => undef
                                },
                  '0-3 (3*)' => {
                                  '0-3-a (3-a)' => undef,
                                  '0-3-b (3-b)' => undef
                                },
                  '1 (2)' => {
                               '0-1-a (2-a*)' => undef,
                               '1-a (2-b)' => {
                                                '1-a-A (2-b-A)' => undef,
                                                '1-a-B (2-b-B)' => undef,
                                                '1-a-C (2-b-C)' => undef
                                              }
                             },
                  '2 (4)' => {
                               '2-a (4-a)' => undef,
                               '2-b (4-b)' => undef
                             }
                );

[cmcmc]

Ah ok, je vois !
Faut reprendre la structure de philou, ou bien partir d'autre chose si tu veux. C'était surtout pour expliquer la hiérarchie du sommaire.

Pour mon programme je remplirais ce hash ou tableau comme ça vous arrange.

Dans la solution présentée ci-dessus, la table %p associe les nouveaux numéros (les clés) aux anciens (les valeurs)... Elle devrait te permettre de modifier ta structure de données comme tu le souhaites.

Cette solution est donc indépendante de l'implémentation, ce qui est généralement considéré plutôt désirable.

Par contre, pour l'utiliser, c'est à toi de produire la liste des numéros (ce qui devrait être trivial).

le say ... for de la solution est là uniquement pour tirer parti du fait que le map produit la liste des nouveaux numéros. Si tout ce que tu veux c'est la table de correspondances, tu peux la repackager

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
sub renumerote {
    my (@d, %k, %p) = map { ord($_) - 1 } qw(1 a A);
    map {
	++$d[my $n = -1 + split q{-}];
	$p{my $x = join q{-}, map chr, @d[0 .. $n]} = $_;
	$x;
    } grep { 
	my ($b, $p, $m) = m/^((?:(.*)-)?.*?)([*])?$/;
	!$m and (!$p or $k{$p}) and ++$k{$b} and $b
    } sort @_;
    \%p;
}

[djibril]

@philou : en modifiant légèrement ton code, j'arrive à une correspondance voulu :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
#!/usr/bin/perl
use warnings;
use strict;
 
#!/usr/bin/perl
 
use strict;
use warnings;
use feature qw(:5.14);
 
use Data::Dumper;
$Data::Dumper::Sortkeys++;
 
my $sommaire = {
	'1*' => { '1-a' => undef,  '1-b' => undef, },
	'2'  => { '2-a*' => undef, '2-b' => { '2-b-A' => undef, '2-b-B' => undef, '2-b-C' => undef }, },
	'3*' => { '3-a' => undef,  '3-b' => undef, },
	'4'  => { '4-a' => undef,  '4-b' => undef, },
};
 
say Data::Dumper->Dump([$sommaire], [qw($sommaire)]);
  my $new_sommaire_final = {};
 
sub update_level($;@);
sub update_level($;@) {
  my ($s, @changes) = @_;
 
  my $new_s = { };
  return undef if !defined $s;
 
  my @level;
  foreach my $num (sort keys %$s) {
    my $old_num = $num;
    my $sub_level = $s->{$num};
    foreach my $change (@changes) {
      my ($old, $new) = @$change;
      $num =~ s/^$old/$new/;
    }
    my $to_remove = $num =~ s/\*$//;
    push @level, $num;
    if ($to_remove) {
      $new_s->{"0-$num ($old_num)"} = update_level($sub_level, @changes, [ $num, "0-$num" ]);
	  $new_sommaire_final->{$old_num} = "0-$num";
    }
    else {
      my $current_num = shift @level;
      $new_s->{"$current_num ($old_num)"} = update_level($sub_level, @changes, [ $num, $current_num ]);
	  $new_sommaire_final->{$old_num} = $current_num;
    }
  }
 
  return $new_s;
}
 
my $new_sommaire = update_level($sommaire);
say Data::Dumper->Dump([$new_sommaire], [qw(*new_sommaire)]);
say Data::Dumper->Dump([$new_sommaire_final], [qw(*new_sommaire_final)]);

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
$sommaire = {
              '1*' => {
                        '1-a' => undef,
                        '1-b' => undef
                      },
              '2' => {
                       '2-a*' => undef,
                       '2-b' => {
                                  '2-b-A' => undef,
                                  '2-b-B' => undef,
                                  '2-b-C' => undef
                                }
                     },
              '3*' => {
                        '3-a' => undef,
                        '3-b' => undef
                      },
              '4' => {
                       '4-a' => undef,
                       '4-b' => undef
                     }
            };
 
%new_sommaire = (
                  '0-1 (1*)' => {
                                  '0-1-a (1-a)' => undef,
                                  '0-1-b (1-b)' => undef
                                },
                  '0-3 (3*)' => {
                                  '0-3-a (3-a)' => undef,
                                  '0-3-b (3-b)' => undef
                                },
                  '1 (2)' => {
                               '0-1-a (2-a*)' => undef,
                               '1-a (2-b)' => {
                                                '1-a-A (2-b-A)' => undef,
                                                '1-a-B (2-b-B)' => undef,
                                                '1-a-C (2-b-C)' => undef
                                              }
                             },
                  '2 (4)' => {
                               '2-a (4-a)' => undef,
                               '2-b (4-b)' => undef
                             }
                );
 
%new_sommaire_final = (
                        '1*' => '0-1',
                        '1-a' => '0-1-a',
                        '1-b' => '0-1-b',
                        '2' => '1',
                        '2-a*' => '0-1-a',
                        '2-b' => '1-a',
                        '2-b-A' => '1-a-A',
                        '2-b-B' => '1-a-B',
                        '2-b-C' => '1-a-C',
                        '3*' => '0-3',
                        '3-a' => '0-3-a',
                        '3-b' => '0-3-b',
                        '4' => '2',
                        '4-a' => '2-a',
                        '4-b' => '2-b'
                      );

Il ne me reste plus qu'à créer le hash de départ.

@cmcmc je vais essayer de tester ton code pour arriver au même résultat.

[djibril]

cmc, ton code fonctionne parfaitement et m'arrange car je peux partir d'un tableau.
Dans tous les cas, il faut que je teste vos deux codes à partir d'un sommaire plus complexe qui contiendra des chiffres romains car ce sera presque tout le temps le cas.

[djibril]

cmcmc, ce n'est pas bon du tout.

code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
say Dumper \@sections;
 
my %ref_sommaire_cmcmc = reverse renumerote(@sections);
 
 
say Data::Dumper->Dump([\%ref_sommaire_cmcmc], [qw(*ref_sommaire_cmcmc)]);
 
sub renumerote {
    my (@d, %k, %p) = map { ord($_) - 1 } qw(I A 1 a);
    map {
	++$d[my $n = -1 + split q{-}];
	$p{my $x = join q{-}, map chr, @d[0 .. $n]} = $_;
	$x;
    } grep { 
	my ($b, $p, $m) = m/^((?:(.*)-)?.*?)([*])?$/;
	!$m and (!$p or $k{$p}) and ++$k{$b} and $b
    } sort @_;
    %p;
}

Résultat :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
$VAR1 = [
          'I-A-1-a',
          'I-A-1',
          'I-A-2-a',
          'I-A-2-b',
          'I-A-2-c',
          'I-A-2',
          'I-A-3-a',
          'I-A-3-b',
          'I-A-3-c',
          'I-A-3-d',
          'I-A-3-e',
          'I-A-3',
          'I-A-4',
          'I-A',
          'I-B-1-a',
          'I-B-1-b',
          'I-B-1-c',
          'I-B-1-d',
          'I-B-1-e',
          'I-B-1',
          'I-B-2-a',
          'I-B-2-b',
          'I-B-2-c',
          'I-B-2',
          'I-B-3-a',
          'I-B-3-b',
          'I-B-3-c',
          'I-B-3',
          'I-B-4',
          'I-B-5-a',
          'I-B-5-b',
          'I-B-5-c',
          'I-B-5',
          'I-B-6-a',
          'I-B-6-b',
          'I-B-6',
          'I-B',
          'I*',
          'II-A-1',
          'II-A-2',
          'II-A-3-a',
          'II-A-3-b',
          'II-A-3-c',
          'II-A-3-d',
          'II-A-3',
          'II-A-4',
          'II-A-5',
          'II-A-6',
          'II-A-7',
          'II-A-8',
          'II-A',
          'II-B-1-a',
          'II-B-1-b',
          'II-B-1-c',
          'II-B-1-d',
          'II-B-1',
          'II-B-2-a',
          'II-B-2-b',
          'II-B-2-c',
          'II-B-2-d',
          'II-B-2-e',
          'II-B-2',
          'II-B-3-a',
          'II-B-3-b',
          'II-B-3-c',
          'II-B-3-d',
          'II-B-3-e',
          'II-B-3',
          'II-B-4-a',
          'II-B-4-b',
          'II-B-4-c',
          'II-B-4',
          'II-B',
          'II-C-1-a',
          'II-C-1-b',
          'II-C-1',
          'II-C-2-a',
          'II-C-2-b',
          'II-C-2-c',
          'II-C-2-d',
          'II-C-2',
          'II-C-3',
          'II-C-4-a',
          'II-C-4-b',
          'II-C-4-c',
          'II-C-4',
          'II-C',
          'II-D-1-a',
          'II-D-1-b',
          'II-D-1-c',
          'II-D-1',
          'II-D-2-a',
          'II-D-2-b',
          'II-D-2-c',
          'II-D-2-d',
          'II-D-2-e',
          'II-D-2-f',
          'II-D-2-g',
          'II-D-2',
          'II-D-3-a',
          'II-D-3-b',
          'II-D-3-c',
          'II-D-3',
          'II-D-4-a',
          'II-D-4-b',
          'II-D-4-c',
          'II-D-4-d',
          'II-D-4',
          'II-D',
          'II*',
          'III-A-1-a',
          'III-A-1-b',
          'III-A-1',
          'III-A-2',
          'III-A-3-a',
          'III-A-3-b',
          'III-A-3',
          'III-A-4-a',
          'III-A-4-b',
          'III-A-4-c',
          'III-A-4',
          'III-A-5-a',
          'III-A-5-b',
          'III-A-5-c',
          'III-A-5-d',
          'III-A-5',
          'III-A',
          'III-B-1-a',
          'III-B-1-b',
          'III-B-1',
          'III-B-2-a',
          'III-B-2-b',
          'III-B-2',
          'III-B-3-a',
          'III-B-3-b',
          'III-B-3-c',
          'III-B-3-d',
          'III-B-3-e',
          'III-B-3',
          'III-B-4',
          'III-B-5',
          'III-B',
          'III-C-1',
          'III-C-2-a',
          'III-C-2-b',
          'III-C-2-c',
          'III-C-2-d',
          'III-C-2',
          'III-C-3',
          'III-C',
          'III-D-1-a',
          'III-D-1-b',
          'III-D-1-c',
          'III-D-1',
          'III-D-2-a',
          'III-D-2-b',
          'III-D-2',
          'III-D-3-a',
          'III-D-3-b',
          'III-D-3-c',
          'III-D-3-d',
          'III-D-3-e',
          'III-D-3-f',
          'III-D-3-g',
          'III-D-3',
          'III-D',
          'III*',
          'IV-A-1-a',
          'IV-A-1-b',
          'IV-A-1-c',
          'IV-A-1-d',
          'IV-A-1',
          'IV-A-2-a',
          'IV-A-2-b',
          'IV-A-2-c',
          'IV-A-2-d',
          'IV-A-2-e',
          'IV-A-2-f',
          'IV-A-2-g',
          'IV-A-2',
          'IV-A-3-a',
          'IV-A-3-b',
          'IV-A-3-c',
          'IV-A-3',
          'IV-A-4-a',
          'IV-A-4-b',
          'IV-A-4-c',
          'IV-A-4-d',
          'IV-A-4-e',
          'IV-A-4-f',
          'IV-A-4',
          'IV-A',
          'IV-B-1-a',
          'IV-B-1-b',
          'IV-B-1-c',
          'IV-B-1-d',
          'IV-B-1-e',
          'IV-B-1',
          'IV-B-2-a',
          'IV-B-2-b',
          'IV-B-2-c',
          'IV-B-2-d',
          'IV-B-2',
          'IV-B-3-a',
          'IV-B-3-b',
          'IV-B-3',
          'IV-B',
          'IV-C-1',
          'IV-C-2',
          'IV-C-3',
          'IV-C-4',
          'IV-C-5',
          'IV-C-6',
          'IV-C-7-a',
          'IV-C-7',
          'IV-C-8-a',
          'IV-C-8',
          'IV-C',
          'IV-D-1',
          'IV-D-2',
          'IV-D-3',
          'IV-D-4',
          'IV-D-5',
          'IV-D-6-a',
          'IV-D-6-b',
          'IV-D-6-c',
          'IV-D-6-d',
          'IV-D-6',
          'IV-D',
          'IV-E-1',
          'IV-E-2',
          'IV-E-3',
          'IV-E-4',
          'IV-E-5',
          'IV-E-6',
          'IV-E',
          'IV-F-1',
          'IV-F-2',
          'IV-F-3',
          'IV-F',
          'IV-G-1-a',
          'IV-G-1-b',
          'IV-G-1-c',
          'IV-G-1-d',
          'IV-G-1-e',
          'IV-G-1-f',
          'IV-G-1-g',
          'IV-G-1',
          'IV-G-2-a',
          'IV-G-2-b',
          'IV-G-2-c',
          'IV-G-2-d',
          'IV-G-2',
          'IV-G-3-a',
          'IV-G-3-b',
          'IV-G-3-c',
          'IV-G-3-d',
          'IV-G-3',
          'IV-G',
          'IV*',
          'V-A-1',
          'V-A-2',
          'V-A-3',
          'V-A',
          'V-B-1',
          'V-B-2-a',
          'V-B-2-b',
          'V-B-2',
          'V-B-3',
          'V-B-4-a',
          'V-B-4-b',
          'V-B-4-c',
          'V-B-4-d',
          'V-B-4',
          'V-B-5',
          'V-B-6',
          'V-B-7',
          'V-B',
          'V-C-1-a',
          'V-C-1-b',
          'V-C-1-c',
          'V-C-1-d',
          'V-C-1-e',
          'V-C-1-f',
          'V-C-1',
          'V-C-2-a',
          'V-C-2-b',
          'V-C-2-c',
          'V-C-2-d',
          'V-C-2-e',
          'V-C-2-f',
          'V-C-2',
          'V-C',
          'V-D-1-a',
          'V-D-1-b',
          'V-D-1-c',
          'V-D-1',
          'V-D-2-a',
          'V-D-2-b',
          'V-D-2-c',
          'V-D-2',
          'V-D',
          'V-E-1',
          'V-E-2',
          'V-E-3',
          'V-E',
          'V-F',
          'V*',
          'VI-A-1-a',
          'VI-A-1-b',
          'VI-A-1-c',
          'VI-A-1',
          'VI-A-2-a',
          'VI-A-2-b',
          'VI-A-2-c',
          'VI-A-2-d',
          'VI-A-2-e',
          'VI-A-2',
          'VI-A',
          'VI-B-1-a',
          'VI-B-1-b',
          'VI-B-1-c',
          'VI-B-1-d',
          'VI-B-1-e',
          'VI-B-1',
          'VI-B-2-a',
          'VI-B-2-b',
          'VI-B-2-c',
          'VI-B-2-d',
          'VI-B-2-e',
          'VI-B-2',
          'VI-B-3-a',
          'VI-B-3',
          'VI-B-4-a',
          'VI-B-4-b',
          'VI-B-4-c',
          'VI-B-4-d',
          'VI-B-4',
          'VI-B-5-a',
          'VI-B-5-b',
          'VI-B-5-c',
          'VI-B-5-d',
          'VI-B-5-e',
          'VI-B-5',
          'VI-B',
          'VI-C-1-a',
          'VI-C-1-b',
          'VI-C-1-c',
          'VI-C-1-d',
          'VI-C-1-e',
          'VI-C-1',
          'VI-C-2',
          'VI-C-3',
          'VI-C-4-a',
          'VI-C-4-b',
          'VI-C-4-c',
          'VI-C-4-d',
          'VI-C-4-e',
          'VI-C-4',
          'VI-C',
          'VI',
          'VII*'
        ];
 
%ref_sommaire_cmcmc = (
                        'VI' => 'I',
                        'VI-A' => 'I-A',
                        'VI-A-1' => 'I-A-1',
                        'VI-A-1-a' => 'I-A-1-a',
                        'VI-A-1-b' => 'I-A-1-b',
                        'VI-A-1-c' => 'I-A-1-c',
                        'VI-A-2' => 'I-A-2',
                        'VI-A-2-a' => 'I-A-2-d',
                        'VI-A-2-b' => 'I-A-2-e',
                        'VI-A-2-c' => 'I-A-2-f',
                        'VI-A-2-d' => 'I-A-2-g',
                        'VI-A-2-e' => 'I-A-2-h',
                        'VI-B' => 'I-B',
                        'VI-B-1' => 'I-B-3',
                        'VI-B-1-a' => 'I-B-3-i',
                        'VI-B-1-b' => 'I-B-3-j',
                        'VI-B-1-c' => 'I-B-3-k',
                        'VI-B-1-d' => 'I-B-3-l',
                        'VI-B-1-e' => 'I-B-3-m',
                        'VI-B-2' => 'I-B-4',
                        'VI-B-2-a' => 'I-B-4-n',
                        'VI-B-2-b' => 'I-B-4-o',
                        'VI-B-2-c' => 'I-B-4-p',
                        'VI-B-2-d' => 'I-B-4-q',
                        'VI-B-2-e' => 'I-B-4-r',
                        'VI-B-3' => 'I-B-5',
                        'VI-B-3-a' => 'I-B-5-s',
                        'VI-B-4' => 'I-B-6',
                        'VI-B-4-a' => 'I-B-6-t',
                        'VI-B-4-b' => 'I-B-6-u',
                        'VI-B-4-c' => 'I-B-6-v',
                        'VI-B-4-d' => 'I-B-6-w',
                        'VI-B-5' => 'I-B-7',
                        'VI-B-5-a' => 'I-B-7-x',
                        'VI-B-5-b' => 'I-B-7-y',
                        'VI-B-5-c' => 'I-B-7-z',
                        'VI-B-5-d' => 'I-B-7-{',
                        'VI-B-5-e' => 'I-B-7-|',
                        'VI-C' => 'I-C',
                        'VI-C-1' => 'I-C-8',
                        'VI-C-1-a' => 'I-C-8-}',
                        'VI-C-1-b' => 'I-C-8-~',
                        'VI-C-1-c' => 'I-C-8-',
                        'VI-C-1-d' => 'I-C-8-€',
                        'VI-C-1-e' => 'I-C-8-',
                        'VI-C-2' => 'I-C-9',
                        'VI-C-3' => 'I-C-:',
                        'VI-C-4' => 'I-C-;',
                        'VI-C-4-a' => 'I-C-;-‚',
                        'VI-C-4-b' => 'I-C-;-ƒ',
                        'VI-C-4-c' => 'I-C-;-„',
                        'VI-C-4-d' => 'I-C-;-…',
                        'VI-C-4-e' => 'I-C-;-†'
                      );

[cmcmc]

cmcmc, ce n'est pas bon du tout.

ben non, ça ne risque pas. J'avais averti :

Ci-dessous une version limitée (0-9, a-z, A-Z, pas de chiffres romains) pour illustrer le principe général.

l'astuce utilisée pour incrémenter les numéros fonctionne pour les digits (de 1 à 9), les minuscules (de 'a' à 'z') et les majuscules (de 'A' à 'Z'), parce que dans les trois cas il s'agit de séquence de caractères consécutifs (en ASCII et UTF-8, je n'en sais rien pour EBCDIC et autres...).

C'était à titre purement illustratif.

Dans une véritable appli, il faut quelque chose de plus sérieux. Et pour commencer, il faut savoir si la numérotation est uniforme sur tout le sommaire (tous les noeuds de même profondeur utilisent le même type) ou si elle peut varier d'une section à l'autre, par exemple 1-a, 1-b, 1-c mais 2-i, 2-ii, 2-iii, 2-iv ....

[djibril]

La numérotation est uniforme. Elle est issue d'un vrai sommaire issu d'un outil bureautique.

[Lolo78]

Par un bienheureux hasard (parce que I < V, ou plutôt I lt V), un simple sort marche bien sur les premiers chiffres romains, mais ça ne marche plus du tout à partir de 9 (IX) qui se retrouve avant 5 (V):

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
my @romains = qw / I II VII III VIII IV V VI IX X/;
print join " ", sort @romains; # FAUX - imprime  I II III IV IX V VI VII VIII X

Il faut donc mettre en œuvre un sort plus complexe. Ce n'est pas trop difficile si l'ordre des niveaux est toujours le même, mais assez nettement plus si les chiffres romains peuvent apparaître à des niveaux différents.

De même, s'il y a plus de 9 sections numérotées par des chiffres arabes, cela ne marchera plus, car 10 apparaîtra entre 1 et 2:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

print join " ", sort 1..10; # imprime 1 10 2 3 4 5 6 7 8 9

EDIT: je n'avais pas vu les deux derniers messages quand j'ai commencé à poster le mien.

[djibril]

On peut ruser en utilisant le module Math::Roman.

[djibril]

En aparté :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
use Math::Roman qw(roman);
my @romains = qw / I II VII III VIII IV V VI IX XI M/;
print join " ", sort { roman($a) <=> roman($b) } @romains;

[cmcmc]

La numérotation est uniforme. Elle est issue d'un vrai sommaire issu d'un outil bureautique.

OK, je suppose en plus que la numérotation commence systématiquement par 1/a/A/i/I à chaque niveau.

Moyennant cette hypothèse, la version jointe autodétecte le type de numérotation utilisé dans les différents niveaux, et devrait incrémenter correctement chaque type (je n'ai pas vérifié exhaustivement...).

Par contre il faut lui passer la série des numéros déjà triée par ordre des sections/sous sections, etc.

Si tu veux te faire plaisir, tu peux essayer de développer une fonction qui autodétecte les types de numérotations et trie une série désordonnée de numéros. Les fonctions aton fournies devraient être utiles...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
# sommaire5.pl
use strict;
use warnings;
use 5.014;
 
my %fmt = (
    '1' => {
	ntoa => sub { $_[0] + 1 },
	aton => sub { $_[0] - 1 }
    },
    'a' => {
	ntoa => sub { my ($n) = @_;  my $s = ""; while ($n) {$s = chr(ord(q{a})+($n-1)%26) . $s, $n = int(($n-1)/26)} $s},
	aton => sub { my $n = 0; $n += $n*25 + ord($_) - ord('a') + 1 for split '', $_[0]; $n}
    },
    'A' => {
	ntoa => sub { my ($n) = @_;  my $s = ""; while ($n) {$s = chr(ord(q{A})+($n-1)%26) . $s, $n = int(($n-1)/26)} $s},
	aton => sub { my $n = 0; $n += $n*25 + ord($_) - ord('A') + 1 for split '', $_[0]; $n}
    },
    'i' => {
	ntoa => sub { use Roman; roman($_[0]) },
	aton => sub { use Roman; arabic($_[0]) },
    },
    'I' => {
	ntoa => sub { use Roman; Roman($_[0]) },
	aton => sub { use Roman; arabic($_[0]) },
    },
    );
 
sub renumerote {
    my (@d, @t, %k, %p);
    # autodétection du type utilisé
    for (@_) {
	my @n = split q{-}, s/\*$//r;
        $t[$#n] //= $n[$#n];
    }
    $d[$_] = 0 for 0 .. $#t;
    # say +(q{ } x (2 * split q{-})), "$_ (ex $p{$_})" for 
    map {
	my @n = split q{-};
	++$d[$#n];
	my $x = join q{-}, map { $fmt{$t[$_]}{ntoa}->($d[$_]) } 0 .. $#n;
	$p{$x} = $_;
	$x;
    } grep { 
	my ($b, $p, $m) = m/^((?:(.*)-)?.*?)([*])?$/;
	!$m and (!$p or $k{$p}) and ++$k{$b} and $b
    } @_;
    \%p;
}
 
 
my @sorted_sections = qw(i* i-a i-b ii ii-a* ii-b ii-b-A ii-b-B ii-b-C iii* iii-a iii-b iv iv-a iv-b );
use Data::Dumper;
print Dumper(renumerote(@sorted_sections));

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Taisha:~/tttmp/sommaire $ perl sommaire5.pl
$VAR1 = {
          'i-a-A' => 'ii-b-A',
          'i-a-B' => 'ii-b-B',
          'ii' => 'iv',
          'i-a-C' => 'ii-b-C',
          'ii-b' => 'iv-a',
          'i' => 'ii',
          'i-a' => 'ii-b',
          'ii-c' => 'iv-b'
        };
Taisha:~/tttmp/sommaire $