Forum |  HardWare.fr | News | Articles | PC | S'identifier | S'inscrire | Shop Recherche
2112 connectés 

  FORUM HardWare.fr
  Programmation
  Perl

  script perl

 



 Mot :   Pseudo :  
 
Bas de page
Auteur Sujet :

script perl

n°2190147
sanfoura2
keep smiling
Posté le 14-05-2013 à 17:03:47  profilanswer
 

Bonjour,
Serait il possible de m'aider à traduire un petit script de R en perl?
cdt,  
 
 
 
voici le script en R;
#Lire l'ensemble de tes fichiers dans R  
 
filenames<-dir("/Volumes/EQ15_SM",pattern="\\.txt" )
Files_res<-list()
names_files<-substr(filenames,1,5) # extraire le nom commun de tous tes fichiers  
for(i in names_files){
  filepath <- file.path("/Volumes/EQ15_SM",paste(i,".txt",sep="" ))
  Files_res[[i]]<-assign(i, read.delim(filepath,head=T))
  }
 
 
###Récupérer les colonnes 1:3 ainsi que les colonnes commencant par BB ou BP
noms<-colnames(Files_res[[1]])   # juste pour récupérer les noms de colonnes  
start_with_BBorBP_3first <- noms %in% grep("^BB|^BP", noms, value=TRUE) | noms%in%noms[1:3]
Files_BBBP<-list()
for(i in 1:length(Files_res)){
   
  Files_BBBP[[i]]<-subset(Files_res[[i]], ,start_with_BBorBP_3first)
}
 
 
#les nouveaux fichiers sont dans la liste Files_BBBP
 
 
 
 
 
# La fonction pour convertir en log2  
logmatfunction<-function(M){
   
  indic<-grep("raw",colnames(M))
  M[,indic]<-log2(M[,indic])
  return(M)
}
 
Files_fin<-list()
for(i in 1:length(Files_BBBP))
{
  Files_fin[[i]]<-logmatfunction(Files_BBBP[[i]])
   
  }
   
 
 
 
#Exporter tous les  fichiers tranformés  
names(Files_fin)<-names(Files_res)
 
## changer le nom des colonnes
for(i in 1:length(Files_fin))
{
  colnames(Files_fin[[i]])[1:3]<-c("Name","Chr","pos" )
  colnames(Files_fin[[i]])<-c(colnames(Files_fin[[i]])[1:3],gsub("\\  ","",paste(substr(gsub("\\.","", colnames(Files_fin[[i]]))[-c(1:3)],1,8),"",".Log R ratio" )))
   
}
 
for(i in seq_along(Files_fin)) {
  write.table(Files_fin[[i]], paste(names(Files_fin)[i], ".pc", sep = "" ),  
              row.names = FALSE, sep = "\t", quote = FALSE)
}
 
 
 
 
 

mood
Publicité
Posté le 14-05-2013 à 17:03:47  profilanswer
 

n°2190151
gilou
Modérateur
Modzilla
Posté le 14-05-2013 à 17:41:34  profilanswer
 

Bonjour,
 
Ça doit pas être très dur, mais il faudrait  
1) expliquer ce que fait chaque ligne de ton script (je connais pas le R, et une ligne comme ceci: Files_res[[i]]<-assign(i, read.delim(filepath,head=T) m'est pas directement compréhensible, vu que je ne connais pas la notation [[ ]] ou la fonction assign)  
2) coller qques lignes d'un de tes fichiers de départ, que je puisse faire un peu de test si nécessaire et en particulier, une ligne de début de fichier (ou il y a les en-tête).
 
Si je devine bien avec ma boule de crystal, dans un répertoire donné, vous filtrez les fichier en extension .txt, vous récupérez une liste des noms (sans extension) de ces fichiers (noms tous en 5 caractères?), et on arrive à la ligne avec le assign...
 
A+,


Message édité par gilou le 14-05-2013 à 17:48:06

---------------
There's more than what can be linked! --    Iyashikei Anime Forever!    --  AngularJS c'est un framework d'engulé!  --
n°2190550
gilou
Modérateur
Modzilla
Posté le 17-05-2013 à 04:19:34  profilanswer
 

A priori, ceci devrait le faire, aux différences de la dernière décimale du log2 près
 

Code :
  1. #!/usr/bin/perl
  2. use strict;
  3. use warnings;
  4. use autodie;
  5. use Cwd;
  6. use Scalar::Util qw(looks_like_number);
  7.  
  8. my $initdir = getcwd();
  9. my $dir = '/Volumes/EQ15_SM';
  10. chdir($dir);
  11. my @flist = glob("*.txt" );
  12. foreach my $infile (@flist) {
  13.  next unless ($infile =~/^[^.].*\.txt$/);
  14.  my $outfile = $infile =~ s/^(.*)(\.txt)$/${1}_final${2}/r;
  15.  my (@outcols, @logcols);
  16.  open(my $infh,  '<', $infile);
  17.  open(my $outfh, '>', $outfile);
  18.  while (my $line = <$infh> ) {
  19.    chomp $line;
  20.    my @cols = split(/\t/, $line);
  21.    if ($. == 1) {
  22.      push @outcols, 0..2, grep($cols[$_] =~ /^B(B|P)/, 0..$#cols);
  23.      @cols = @cols[@outcols];
  24.      @logcols = grep($cols[$_] =~ /raw/, 0..$#cols);
  25.      $cols[0] = "Name";
  26.      $cols[1] = "Chr";
  27.      $cols[2] = "Position";
  28.      foreach (@cols) {
  29.          if (/^B(B|P)/) {
  30.            s/-//g;
  31.            s/_raw$/.Log R Ratio/ or s/_baf$/.B Allele Freq/ or s/_cn$/.cn/;
  32.          }
  33.      }
  34.    }
  35.    else {
  36.      @cols = @cols[@outcols];
  37.      foreach (@logcols) {
  38.         $cols[$_] = log($cols[$_])/log(2);
  39.      }
  40.      @cols = map {looks_like_number($_)?0+$_:$_} @cols;
  41.    }
  42.    print $outfh join("\t", @cols), "\n";
  43.  }
  44.  close($infh);
  45.  close($outfh);
  46. }
  47. chdir($initdir);


 
A+,


Message édité par gilou le 17-05-2013 à 04:23:50

---------------
There's more than what can be linked! --    Iyashikei Anime Forever!    --  AngularJS c'est un framework d'engulé!  --
n°2190593
gilou
Modérateur
Modzilla
Posté le 17-05-2013 à 13:29:26  profilanswer
 

use Cwd;
...  
my $initdir = getcwd();
my $dir = '/Volumes/EQ15_SM';
chdir($dir);
...
chdir($initdir);


On va aller faire le travail dans le répertoire cible, puis revenir au répertoire de départ une fois le travail terminé.
Manifestement, le programme R se coltine des noms complets, ce qui n'a aucun intérêt:
 filepath <- file.path("/Volumes/EQ15_SM",paste(i,".txt",sep="" ))  
 

my @flist = glob("*.txt" );
foreach my $infile (@flist) {
  next unless ($infile =~/^[^.].*\.txt$/);
  ...
}


On récupère avec glob la liste des fichiers en .txt du répertoire, et on va travailler un par un sur chacun (foreach...)
On saute les fichiers commençant par un . (j'ai pas testé l'expression régulière /^[^.].*\.txt$/ car windows XP n'accepte pas les fichiers commençant avec un . apparement mais elle devrait être bonne.) Si je saute ces fichiers, c'est parce que j'ai lu que la fonction R qui est utilisée le faisait
filenames<-dir("/Volumes/EQ15_SM",pattern="\\.txt" )  
 
 

my $outfile = $infile =~ s/^(.*)(\.txt)$/${1}_final${2}/r;


Je construis le nom du fichier de sortie en insérant _final dans le nom du fichier d'entrée
Le code R fait des choses qui sont un peu inutiles ou complexes, qui exploitent le fait que les fichier ont des noms de exactement 5 caractères avant l'extension:
names_files<-substr(filenames,1,5)  
...
write.table(Files_fin[[i]], paste(names(Files_fin)[i], ".pc", sep = "" ),  
C'est avec une extension .pc que c'est fait ici et non _final.txt
Si vous voulez un nom de fichier résultat avec .pc, il suffit de changer mon code en:
my $outfile = $infile =~ s/^(.*)(\.txt)$/${1}.pc/r;
 

open(my $infh,  '<', $infile);
open(my $outfh, '>', $outfile);
.....
close($infh);
close($outfh);

On ouvre en lecture le fichier d'entrée, en écriture celui de sortie, et on les ferme après traitement
 

while (my $line = <$infh> ) {
    chomp $line;
    my @cols = split(/\t/, $line);
....
}

On lit le fichier ligne a ligne et on traite chaque ligne.
D'abord on vire le retour a la ligne final, puis on découpe la ligne comme des champs de texte séparés par des tabulations.
 

if ($. == 1) {
      push @outcols, 0..2, grep($cols[$_] =~ /^B(B|P)/, 0..$#cols);
      @cols = @cols[@outcols];
      @logcols = grep($cols[$_] =~ /raw/, 0..$#cols);
      $cols[0] = "Name";
      $cols[1] = "Chr";
      $cols[2] = "Position";
      foreach (@cols) {
         if (/^B(B|P)/) {
           s/-//g;
           s/_raw$/.Log R Ratio/ or s/_baf$/.B Allele Freq/ or s/_cn$/.cn/;
         }
      }
    }


Si c'est la première ligne ($. == 1), on récupère les indices des champs utiles: les 3 premiers (0..2)et ceux qui démarrent par  BB ou BP (/^B(B|P)/)
On ne conserve alors que les champs utiles: @cols = @cols[@outcols];
On cherche maintenant parmi eux les indices de ceux contenant raw (c'est ceux dont on va transformer la valeur avec log2)
On remplace ensuite le texte des têtes de colonne (ie les champs de cette première ligne) par les valeurs voulues en sortie.

else {
 
      @cols = @cols[@outcols];
      foreach (@logcols) {
        $cols[$_] = log($cols[$_])/log(2);
      }
      @cols = map {looks_like_number($_)?0+$_:$_} @cols;
    }


Si ce n'est pas la première ligne, on filtre pour ne garder que les champs attendus en sortie: @cols = @cols[@outcols];
Et pour ceux qui ont besoin du remplacement par le log de la valeur, on fait ce remplacement.
La ligne @cols = map {looks_like_number($_)?0+$_:$_} @cols; c'est pour que en sortie, Perl se comporte comme R:
Quand Perl lit un champ avec 1.48844e+07, pour lui, c'est du texte, et il va l'écrire comme il l'a lue. En effectuant une addition avec 0, Perl va dorénavant considérer le champ comme un nombre et l'écrire 14884400 en sortie (comme le fait R)
 

print $outfh join("\t", @cols), "\n";


On écrit les champs utiles et éventuellement modifiés dans le fichier de sortie.
 
A+,


Message édité par gilou le 17-05-2013 à 13:35:43

---------------
There's more than what can be linked! --    Iyashikei Anime Forever!    --  AngularJS c'est un framework d'engulé!  --
n°2190629
sanfoura2
keep smiling
Posté le 17-05-2013 à 15:19:26  profilanswer
 

J'ai eu ce message d'erreur
 
Can't locate autodie.pm in @INC (@INC contains: /Library/Perl/Updates/5.8.8 /System/Library/Perl/5.8.8/darwin-thread-multi-2level /System/Library/Perl/5.8.8 /Library/Perl/5.8.8/darwin-thread-multi-2level /Library/Perl/5.8.8 /Library/Perl /Network/Library/Perl/5.8.8/darwin-thread-multi-2level /Network/Library/Perl/5.8.8 /Network/Library/Perl /System/Library/Perl/Extras/5.8.8/darwin-thread-multi-2level /System/Library/Perl/Extras/5.8.8 /Library/Perl/5.8.6 /Library/Perl/5.8.1 .) at /users/sourour/desktop/essai/convert2penncnv.pl line 7.
BEGIN failed--compilation aborted at /users/sourour/desktop/essai/convert2penncnv.pl line 7.

n°2190631
sanfoura2
keep smiling
Posté le 17-05-2013 à 15:20:06  profilanswer
 

je suis sur mac si ca peut changer des choses

n°2190679
gilou
Modérateur
Modzilla
Posté le 17-05-2013 à 16:36:15  profilanswer
 

C'est juste que vous n'avez pas le module autodie d'installé. Il faut dire que vous avez une version assez ancienne de Perl, dans les versions récentes il est installé en standard.
 
Plusieurs solutions:
- Mettez a jour votre version de Perl (la version courante est la 5.16 et vous utilisez la 5.8)
ou
- installez le module manquant (si c'est le perl de ActiveState, utiliser ppm, sinon, sur Mac, il faut sans doute passer pas cpan)
ou
- Supprimez le ligne
   use autodie;
   et remplacez les lignes
   open(my $infh,  '<', $infile);  
   open(my $outfh, '>', $outfile);  
   par
   open(my $infh,  '<', $infile) or die "cannot open $infile : $!";  
   open(my $outfh, '>', $outfile) or die "cannot open $outfile : $!";  
 
Mais vous aurez de toute façon le même problème pour le module Scalar::Util et lui, il faudra bien que vous l'installiez de toute façon, car il n'est pas dans la distribution de base. Il y a ici un article anglais qui vous donne quelques principes de base pour utiliser cpan sur le Mac: http://www.macinstruct.com/node/463
 
EDIT: En y repensant, SI vous êtes sure que toutes les données (pour toutes les lignes sauf la première) sont toujours des valeurs numériques, sauf le premier champ en début de ligne (qui correspond à Name dans l'en tête), alors vous pouvez aussi supprimer la ligne  
use Scalar::Util qw(looks_like_number);
et remplacer la ligne
@cols = map {looks_like_number($_)?0+$_:$_} @cols;
par
foreach (1..$#cols) {
   $cols[$_] += 0;
}
Ce qui vous évitera d'installer le module Scalar::Util
 
 
A+,


Message édité par gilou le 17-05-2013 à 21:33:05

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

Aller à :
Ajouter une réponse
  FORUM HardWare.fr
  Programmation
  Perl

  script perl

 

Sujets relatifs
exécution script Perl sous mac impossibleWin32 invalide en executant 1 script perl via Eclipse
[Perl] Script de transfert FTPScript Perl
[Perl] Demande authentification avec le script mais pas avec Firefoxcgi perl: comment fermer la connexion serveur en continuant le script
[PERL] aide script pour alimenter SGBD MySQLTitre d'un script CGI Perl
[perl]script sauvegarde, telnetScript PERL & PHP pour interface CISCO avec carte CSM
Plus de sujets relatifs à : script perl


Copyright © 1997-2018 Hardware.fr SARL (Signaler un contenu illicite / Données personnelles) / Groupe LDLC / Shop HFR