fichier pgn des échecs mise en forme et génération

fichier pgn des échecs mise en forme et génération - Perl - Programmation

Marsh Posté le 31-08-2015 à 12:28:58    

Bonjour.  
 
Dans le monde des échecs, il existe un format de fichier très répandu, le fichier pgn.  
Il est une base de donnée de parties, ou d'exercices. La base peut contenir de 1 partie à plusieurs millions de parties.
Le fichier d'entrée est constitué de parties
Chaque partie est un bloc de texte avec l'entête, suivi des coups de la partie.  
Le format et la taille des entêtes peut varier.
Les entêtes sont constitués de []
Je souhaiterais pouvoir générer un fichier qui ne contient pas les coups de la partie.
Pour cela, je dois remplacer l'ensemble des coups d'une partie par une étoile.  
Avant :  
 
[Event "?"]
[Site "?"]
[Date "1976.??.??"]
[Round "?"]
[White ""]
[Black ""]
[Result "0-1"]
[FEN "6k1/p4p1p/1p2p1p1/1Q6/3r3q/5B1b/PP3P1P/R4RK1 b - - 0 1"]
[SetUp "1"]
[PlyCount "7"]
 
{[%tqu "","","",Qg4+,"",3]} 1... Qg4+ 2. Bxg4 Rxg4+ 3. Kh1 Bg2+ 4. Kg1 Bf3# 0-1
 
après
 
[Event "?"]
[Site "?"]
[Date "1976.??.??"]
[Round "?"]
[White "Farago"]
[Black "Rigo"]
[Result "*"]
[FEN "6k1/p4p1p/1p2p1p1/1Q6/3r3q/5B1b/PP3P1P/R4RK1 b - - 0 1"]
[SetUp "1"]
[PlyCount "7"]
 
*
 
Le seul risque est que les coups de la partie peuvent prendre plusieurs lignes.  
 
 
 
A terme, le fichier source ressemblerait à ceci,  
[Event "?"]
[Site "?"]
[Date " "]
[Round "? "]
[White " "]
[Black " "]
[Result "1-0"]
[FEN " "]
[SetUp "1"]
 
1... Qa8 2. Ce3#
 
[Event "?"]
[Site "?"]
[Date ""]
[Round " "]
[White " "]
[Black " "]
[Result "*"]
[FEN " "]
[SetUp "1"]
 
2. f3 Qxf3 3. Qd1 *
....
 
Je souhaiterais aussi remplacer le champ Round "".
Remplacer le champ vide ou ? par "position i", i étant un numéro croissant dans la base
si le champ est non vide, insérer au début du champ "position i"
A terme ce champ me servira un autre fichier avec uniquement les coups de la parties et le "position i"
 
Please, help
D'avance merci


Message édité par yozyoz21 le 31-08-2015 à 12:30:08
Reply

Marsh Posté le 31-08-2015 à 12:28:58   

Reply

Marsh Posté le 31-08-2015 à 13:29:54    

Le truc bien avec Perl c'est qu'il y a des modules tout prêts pour à peu près n'importe quoi.
https://metacpan.org/search?q=Chess%3A%3APGN
J'ai pas regardé en détail mais ceci https://metacpan.org/pod/Chess::PGN::Parse a l'air adapté. Sinon on peut certainement faire qu'avec du Regex aussi.

Reply

Marsh Posté le 01-09-2015 à 22:21:10    

Il y a un module qui fait ça tout seul, Chess::pgn
 

Code :
  1. #!/usr/bin/perl
  2. use strict;
  3. use warnings;
  4. use Chess::Pgn;
  5.  
  6.  
  7. sub process_file {
  8.    my ($file, $pos) = @_;
  9.    my $p = new Chess::Pgn($file) || die "$file not found";
  10.    my $more;
  11.    do {
  12.         $more = $p->ReadGame;
  13.         $p->{Game} = "*\n";
  14.         if ($p->{Round} =~ /^(\?)*$/) {
  15.             $p->{Round} = "position $$pos";
  16.             $$pos++;
  17.         }
  18.         print $p->PrintAll;
  19.    } while ($more);
  20.    $p->quit();
  21. }
  22.  
  23. my $pos = 1;
  24. process_file('partie2.pgn', \$pos);


C'est sans doute améliorable, mais ça donne de bonnes indications pour démarrer, ça remplace les coups par une étoile et remplit le champ Round.
 
A+,


Message édité par gilou le 02-09-2015 à 02:42:22

---------------
There's more than what can be linked! --    Iyashikei Anime Forever!    --  AngularJS c'est un framework d'engulé!  --
Reply

Marsh Posté le 02-09-2015 à 11:53:06    

Merci pour cette info, c'est déjà un excellent moyen quand on se sent pas bien opé au début pour affronter un nouveau sujet.

Reply

Marsh Posté le 02-09-2015 à 12:29:16    

Tiens, une version un peu plus clean (pas d'effet de bord) avec un contrôle plus fin sur ce que l'on imprime:
$pos est une variable propre au fichier, donc auto incrémentée et passée par référence, mais on pourrait avoir une valeur extérieure, avec passage par valeur.

Code :
  1. #!/usr/bin/perl
  2. use strict;
  3. use warnings;
  4. use 5.010;
  5.  
  6. use Readonly; # installer Readonly::XS si ce n'est pas fait
  7. use Chess::Pgn;
  8.  
  9. sub custom_print ($$@) {
  10.  my ($p, $pos) = (shift, shift);
  11.  
  12.  foreach (@_) {
  13.    # si le champ Round est vide ou est composé de ?
  14.    if (/Round/ and $p->{Round} =~ /^(\?)*$/) {
  15.      print '[', $_, ' "', 'position ', $$pos++, '"]', "\n";
  16.      next;
  17.    }
  18.    if (/Game/) {
  19.      print "\n*\n\n";
  20.      next;
  21.    }
  22.    print '[', $_, ' "', $p->{$_}, '"]', "\n";
  23.  }
  24. }
  25.  
  26. sub process_file ($$@) {
  27.  my ($file, $pos, @keys) = (shift, shift, @_);
  28.  
  29.  my $p = new Chess::Pgn($file) || die "Fichier $file non trouvé!";
  30.  my $more;
  31.  do {
  32.    $more = $p->ReadGame;
  33.    custom_print($p, $pos, @keys);
  34.  } while ($more);
  35.  $p->quit();
  36. }
  37.  
  38. # tous les mots clés, dans l'ordre de sortie désiré
  39. Readonly my @keys = qw(Event    Site     Date     Round
  40.                White    Black    Result   ECO
  41.                WhiteElo BlackElo PlyCount Game);
  42.  
  43. my $pos = 1;
  44. process_file('partie.pgn', \$pos, @keys);


 
et une variante avec une closure:

Code :
  1. #!/usr/bin/perl
  2. use strict;
  3. use warnings;
  4. use 5.010;
  5.  
  6. use Chess::Pgn;
  7.  
  8. ###
  9. # on simule une fonction extérieure retournant la position et s'auto-incrémentant
  10. # au moyen d'une closure perl
  11. sub make_pos {
  12.  my $pos = 1;
  13.  return sub { $pos++ };
  14. }
  15. my $get_pos = make_pos();
  16. ###
  17.  
  18. sub custom_print ($) {
  19.  my $p = shift;
  20.  
  21.  # tous les mots clés, dans l'ordre de sortie désiré
  22.  use constant KEYS => qw(Event    Site     Date     Round
  23.                           White    Black    Result   ECO
  24.                           WhiteElo BlackElo PlyCount Game);
  25.  
  26.  foreach (KEYS) {
  27.    # si Round et champ vide ou composé de ?
  28.    if (/Round/ and $p->{Round} =~ /^(\?)*$/) {
  29.      print '[', $_, ' "', 'position ', $get_pos->(), '"]', "\n";
  30.      next;
  31.    }
  32.    # si Game
  33.    if (/Game/) {
  34.      print "\n*\n\n";
  35.      next;
  36.    }
  37.    # default
  38.    print '[', $_, ' "', $p->{$_}, '"]', "\n";
  39.  }
  40. }
  41.  
  42. sub process_file($) {
  43.  my $file = shift;
  44.  
  45.  my $p = new Chess::Pgn($file) || die "Fichier $file non trouvé!";
  46.  my $more_games;
  47.  do {
  48.    $more_games = $p->ReadGame;
  49.    custom_print($p);
  50.  } while ($more_games);
  51.  $p->quit();
  52. }
  53.  
  54.  
  55. process_file('partie2.pgn');


 
A+,


Message édité par gilou le 02-09-2015 à 18:58:51

---------------
There's more than what can be linked! --    Iyashikei Anime Forever!    --  AngularJS c'est un framework d'engulé!  --
Reply

Marsh Posté le 03-09-2015 à 13:20:06    

C'était trop beau, Chess::Pgn est trop simpliste et ne supporte pas les champs FEN ou commentaires, etc.
Chess::PGN::Parse devrait lui marcher.
Je regarde ça et je poste une soluce.
 
Bon déjà, une utilisation 'vanilla' du module, non customisée pour ta sortie:

Code :
  1. #!/usr/bin/perl
  2. use Modern::Perl;               # version moderne de use strict et use warnings, mais il faut installer le module
  3. use experimental 'smartmatch';  # évite le warning lors de l'emploi de ~~ (utilisé pour vérifier si un mot est dans une liste)
  4. use Chess::PGN::Parse;
  5.  
  6. my @mandatory = ('Event', 'Site', 'Date', 'Round', 'White', 'Black', 'Result');
  7. my @optional  = ('WhiteTitle', 'BlackTitle', 'WhiteElo', 'BlackElo',
  8.                  'WhiteUSCF', 'BlackUSCF', 'WhiteNA', 'BlackNA',
  9.                  'WhiteType', 'BlackType',
  10.                  'EventDate', 'EventSponsor',
  11.                  'Section', 'Stage', 'Board',
  12.                  'Opening', 'Variation', 'SubVariation',
  13.                  'ECO', 'NIC',
  14.                  'Time', 'UTCTime', 'UTCDate', 'Timecontrol', 'SetUp',
  15.                  'FEN',
  16.                  'Termination', 'Annotator', 'Mode', 'PlyCount');
  17.  
  18. # Va imprimer en sortie ce qui a été lu en entrée, modulo le parsing de Chess::PGN::Parse
  19. sub process_file($) {
  20.  my $pgnfile = shift;
  21.  my $pgn = Chess::PGN::Parse->new($pgnfile) or die "Erreur fatale a la lecture de $pgnfile!";
  22.  while ($pgn->read_game()) {
  23.    # impression des champs obligatoires (hormis Game), ordre fixé, celui de @mandatory
  24.    foreach (@mandatory) {
  25.      my $text = $pgn->{'gamedescr'}->{$_};
  26.      print "[$_ \"$text\"]\n";
  27.    }
  28.    # impression des champs non-obligatoires connus, ordre de @optional
  29.    # changer l'ordre dans optional selon ses besoins en sortie
  30.    foreach (@optional) {
  31.      if ($pgn->{'gamedescr'}->{$_}) {
  32.        my $text = $pgn->{'gamedescr'}->{$_};
  33.        print "[$_ \"$text\"]\n";
  34.      }
  35.    }
  36.    # impression des champs non-obligatoires restant, ordre aléatoire des clés
  37.    foreach (keys %{$pgn->{'gamedescr'}}) {
  38.      unless ($_ ~~ @mandatory or $_ ~~ @optional or $_ eq 'Game') {
  39.         my $text = $pgn->{'gamedescr'}->{$_};
  40.         print "[$_ \"$text\"]\n";
  41.      }
  42.    }
  43.    # impression du champ Game
  44.    print "\n$pgn->{'gamedescr'}->{'Game'}\n\n";
  45.  }
  46. }
  47.  
  48.  
  49. process_file('partie.pgn');


 
Et la customisation se fait en 5 mn:

Code :
  1. #!/usr/bin/perl
  2. use Modern::Perl;               # version moderne de use strict et use warnings, mais il faut installer le module
  3. use experimental 'smartmatch';  # évite le warning lors de l'emploi de ~~ (utilisé pour vérifier si un mot est dans une liste)
  4. use Chess::PGN::Parse;
  5.  
  6. my @mandatory = ('Event', 'Site', 'Date', 'Round', 'White', 'Black', 'Result');
  7. my @optional  = ('WhiteTitle', 'BlackTitle', 'WhiteElo', 'BlackElo',
  8.                  'WhiteUSCF', 'BlackUSCF', 'WhiteNA', 'BlackNA',
  9.                  'WhiteType', 'BlackType',
  10.                  'EventDate', 'EventSponsor',
  11.                  'Section', 'Stage', 'Board',
  12.                  'Opening', 'Variation', 'SubVariation',
  13.                  'ECO', 'NIC',
  14.                  'Time', 'UTCTime', 'UTCDate', 'Timecontrol', 'SetUp',
  15.                  'FEN',
  16.                  'Termination', 'Annotator', 'Mode', 'PlyCount');
  17.  
  18. sub process_file($) {
  19.  my $pgnfile = shift;
  20.  my $pgn = Chess::PGN::Parse->new($pgnfile) or die "Erreur fatale a la lecture de $pgnfile!";
  21.  while ($pgn->read_game()) {
  22.    # impression des champs obligatoires (hormis Game), ordre fixé, celui de @mandatory
  23.    foreach (@mandatory) {
  24.      my $text = $pgn->{'gamedescr'}->{$_};
  25.      if (/Round/ and $text =~ /^(\?)*$/) {
  26.         $text = 'position ' . $get_pos->();
  27.      }
  28.      print "[$_ \"$text\"]\n";
  29.    }
  30.    # impression des champs non-obligatoires connus, ordre de @optional
  31.    # changer l'ordre dans optional selon ses besoins en sortie
  32.    foreach (@optional) {
  33.      if ($pgn->{'gamedescr'}->{$_}) {
  34.        my $text = $pgn->{'gamedescr'}->{$_};
  35.        print "[$_ \"$text\"]\n";
  36.      }
  37.    }
  38.    # impression des champs non-obligatoires restant, ordre aléatoire des clés
  39.    foreach (keys %{$pgn->{'gamedescr'}}) {
  40.      unless ($_ ~~ @mandatory or $_ ~~ @optional or $_ eq 'Game') {
  41.         my $text = $pgn->{'gamedescr'}->{$_};
  42.         print "[$_ \"$text\"]\n";
  43.      }
  44.    }
  45.    # impression du champ Game
  46.    print "\n*\n\n";
  47.  }
  48. }
  49.  
  50.  
  51. process_file('partie.pgn');


 
A+,


Message édité par gilou le 03-09-2015 à 15:40:36

---------------
There's more than what can be linked! --    Iyashikei Anime Forever!    --  AngularJS c'est un framework d'engulé!  --
Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed