Perl

[perl] Probleme double lecture

Recherche :

Mot : Pseudo : Filtrer
Page : 1 2 Page Suivante Page Précédente Bas de page
Auteur	Sujet : [perl] Probleme double lecture

shadow19c

Bonjour,

J'ai deux tables ,my @positions=(24,48,54,92,137,235,275,324) my @positions=(25,60,54,192) pour la premiere sequence et une autre table pour la deuxieme sequence comme ca javais deux positions pour chaque lettre , et ce que je verifie c'est que est ce que pour chaque position des deux cotes ils correspondaient, cest a dire pour par exemple javais une correspondance du 24 eme lettre qui est en face d'une position de 'lautre sequence .
En faisant attention aux X et ---
En fait c'est pas les lettres qui doivent etre identiques , mais c'est surtout que dans ma collection de position, j'en ai une qui est en face de l'autre.
Par exemple: si j'ai une position 24 pour la premiere sequence et que dans l'autre sequence j'ai une position 60 mais qui sont en face l'une a lautre c'est bon.
merci
voci le fichier blast:

merci

Je dois par exemple si je suis a la position 24 de la premiere sequence je verifie a quelle position je suis dans l'autre sequence si par exemple je suis a une position qui n'est pas dans la collection my @positions=(26,65,145,189); ben je passe a la position suivante pour les deux sequences jusqua ce que , si je suis a la position 65 seq 1 et qu'en face je sois a la position 145 , les deux lettres sont en face la cest bon je renvoi.

merci

Message édité par shadow19c le 13-04-2011 à 09:16:51

Publicité

gilou

Modérateur
Modosaurus Rex

:hello:
Je veux bien t'aider, mais j'ai rien compris à ton problème, tes explications ne sont pas claires du tout.
Si tu expliques clairement ca

Citation :

En fait j'arrive pas a lui dire si j'ai deux couples de positions daller verfier si ils sont allignes , en plus la cest que j'ai fait cest la comparaison de lettre mais cest pas ca ce que je dois faire, cest plus verfier pour chaque position si ils sont alignes.

qu'on y comprenne qque chose, on pourra sans doute t'aider, car au niveau du code perl, ça a pas l'air bien compliqué.
A+,

---------------
There's more than what can be linked! -- Le capitaine qui ne veut pas obéir à la carte finira par obéir aux récifs. -- No jab ? No job ! -- (╯°□°)╯︵ ┻━┻

shadow19c

Oui , excuse moi je reprend comme cest un probleme bioinformatique;je reprend:
En fait mon programme doit a partir de collection de position de deux sequences pour query my @positions=(24,48,54,92,137,235,275,324)
et subject my @positions=(25,60,80,192), aller verifier si ces positions existent sur l'alignement et si ces positions sont l'une face a l'autre.
Je m'explique mieux:
on prend un exemple si je prend le premier bloc
Query: 160 DSVIAAMSKRGQDRLHHVIRILAEKGHVKELATAFYGNYTVQDLLDATHXXXXXXXXXXX 219
+ I A+ ++ +L V+ IL E G V EL T ++GNY++QDL++A
Sbjct: 264 EQAINALQRKSYQKLTRVVDILIESGKVPELVTHYFGNYSIQDLMEACFKLRKSFEKQGR 323

je dois prendre en premier l'index de chaque sequence : 160 pour query et 264 pour subject ,ceci nous permet de nous positionner sur les sequences en effet, lorsque nous allons commencer le lecture des tables, on saura que la lettre D est positionne a 160, puis S a 161 ainsi de suite pour query , et E 264 pour subject. ENsuite pour chque position je verifie si cette position nexiste pas dans ma collection,ainsi si par exemple javais une lettre qui etait a la position 54 pour query et qu'en face(Ceci est important, il faut que la lettre de subject soit en face) j'ai une lettre qui est a la position 80, donc comme deux positions qui existent dans les tables positions et quils sont en face l'une a lautre alors cest bon je renvoi ces deux valeurs 54 et 80, et je continue la lecture jusqua la fin du bloc et puis je continue la meme chose pour les autres blocs recursivement.

EN faisant attention que si jai un x ou - soit sur query ou subject je passe et je fais avancer mes curseurs en meme temps, donc je saute la partie ou il y a X ou - sur la sequence ou il ya mais aussi sur la sequence den face meme si ces des lettres je dois avancer de la meme facon sur les deux sequences;

En fait, si je prend les deux sequences d'un bloc je mets dans une table et javance les curseurs en meme temps position un par un je pourrai faire ceci.

Voila mon probleme , help please

Message édité par shadow19c le 17-03-2011 à 10:52:25

gilou

Modérateur
Modosaurus Rex

Je comprends a peu près, mais j'ai encore quelques questions:
avec pour query @positions=(24,48,54,92,137,235,275,324) et subject @positions=(25,60,80,192)
1) tu as une lettre en position 24 dans query et une en 25 dans subject. Ce que tu veux, c'est que ça soit la même? Ou alors que ça soit pas un X ou un - dans l'une des deux position?
2) si oui, si ca colle pas en position 24 dans query et en 25 dans subject, tu cherches après pour 48 dans query et 25 dans subject? ou quoi?
3)
Une suite comme ca:

Query: 160 DSVIAAMSKRGQDRLHHVIRILAEKGHVKELATAFYGNYTVQDLLDATHXXXXXXXXXXX 219
+ I A+ ++ +L V+ IL E G V EL T ++GNY++QDL++A
Sbjct: 264 EQAINALQRKSYQKLTRVVDILIESGKVPELVTHYFGNYSIQDLMEACFKLRKSFEKQGR 323
Query: 220 XXXXXSQDIERMLGFSDGQDSLGRMARGIAGAMPEGAMHKQGIYVVLKLLEVGDCADILP 279
Q + D GRM + + +PE H G +V+ KLL+ +++
Sbjct: 324 KADDAVQYF-----LNPDTDPFGRMFQEVLKTVPESIKHTAGAFVMQKLLQWLTPQEVVT 378
Query: 280 LASKLFPGGPKLTTDLHSPEAWRGVKIMTGLVDAMSELAHQGGHMSAAAMGLLDSLCGLY 339
L G +T + +G+ M L + Q AA L ++C Y
Sbjct: 379 L------GKVSVTHVMDLANDTKGLHFMLKLSQISLTNSEQDYVKDAAQQ--LHAICHQY 430
Query: 340 LKDEQAVIKLAQHKNY-GPMLVDAASAGLPRPK----CKQVKSWTNQ--PSPAFGASLVW 392
L + ++ G MLV+A + +P P + W+++ P S W
Sbjct: 431 LSSITGSALPSWATSFAGQMLVEAIAGSMPLPSSCTLANNIAGWSSKLLQLPLKDKSTPW 490
Query: 393 KILQRLDD 400
+L++L D
Sbjct: 491 LMLEQLYD 498

C'est toujours consécutif (ie on pourrait recoller le tout avec une query commençant en 160 et finissant en 400, et un subject commençant en 264 et finissant en 498?), et on a juste un découpage en plusieurs lignes de quelque chose d'un seul tenant, ou il peut y avoir des trous?
A+,

Message édité par gilou le 17-03-2011 à 12:08:49

---------------
There's more than what can be linked! -- Le capitaine qui ne veut pas obéir à la carte finira par obéir aux récifs. -- No jab ? No job ! -- (╯°□°)╯︵ ┻━┻

shadow19c

Ben en fait, ce quil faut faire cest de decouper en bloc, DSVIAAMSKRGQDRLHHVIRILAEKGHVKELATAFYGNYTVQDLLDATHXXXXXXXXXXX

EQAINALQRKSYQKLTRVVDILIESGKVPELVTHYFGNYSIQDLMEACFKLRKSFEKQGR

Je met ceci dans deux tables differents, ensuite javance en meme temps dans les deux tables, et je regarde si jai une correspondance de la position qui sont dans mes tables positions, si jai une correspondance de l'une , il faut que en face je dois avoir une position qui doit etre aussi dans la table position.
Si les positions existent dans les deu xtables positions et en face, donc cest bon,

des que je fini ce bloc je passe a lautre , ainsi jusqua la fin

un truc du genre

Code :

Code :
#!usr/bin/perl
use strict;
use warnings;
my $query_seq = 'DSVIAAMSKRGQDRLHHVIRILAEKGHVKELATAFYGNYTVQDLLDATHXXXXXXXXXXX';
my $sbjct_seq = 'EQAINALQRKSYQKLTRVVDILIESGKVPELVTHYFGNYSIQDLMEACFKLRKSFEKQGR';
my $q_start = 160;
my $s_start = 264;
my @tab1 = split(//,$query_seq);
my @tab2 = split(//,$sbjct_seq);
for my $i (0..$#tab1){
if (($tab1[$i] !~ m/[-X]/) && ($tab2[$i] !~ m/[-X]/)){
# vérification que les positions n'existent pas déjà dans tables positions
# ???
}
$q_start ++;
$s_start ++;
}

Code :

#!/usr/bin/perl
use strict;
use warnings;
#Variables
my @positions=(24,48,54,92,137,235,275,324); #Liste des positions que tu souhaites verifier
my @positions2=(26,65,145,189);
my $query_seq;
my $sbjct_seq;
my ($depart_bloc,$fin_bloc)=(0,0);
my $numero_bloc = 1;
open (BLAST_FILE,"<blast.txt" ) or die ("Impossible de lire blast.txt\n" );
while(<BLAST_FILE> )
{
if(/Query: (\d+)\s+(.+)\s+(\d+)/) #Ajout de \s+ pour gerer s'il y a plus d'un espacement
{
$depart_bloc=$1; #Index de depart du bloc
$query_seq=$2; #Sequence Query
$fin_bloc=$3; #Index de fin du bloc
}
elsif(/Sbjct: \d+\s+(.+)/)
{
$sbjct_seq=$1; #Sequence Sbjct
}
#Si les deux sequences "Query" et "Sbjct" ont ete trouvees, on a un nouveau bloc:
if((defined $query_seq) && (defined $sbjct_seq) && ($query_seq =~ m/\w/) && ($sbjct_seq =~ m/\w/))
{
#Separation des caracteres des sequences dans un tableau
my @tab1 = split(//,$query_seq);
my @tab2 = split(//,$sbjct_seq);
my $r = $depart_bloc;
# tableau : clé : AA valeur : position
my %positions_query;
foreach my $aa ( @tab1){
if ($aa ne 'X'){
$positions_query{$aa} = $r;
}
$r ++;
}
my $s = $depart_bloc;
# tableau : clé : AA valeur : position
my %positions_sbjct;
foreach my $aa ( @tab2){
if ($aa ne 'X'){
$positions_sbjct{$aa} = $s;
}
$s ++;
}
# on vide les variables
$query_seq = '';
$sbjct_seq = '';
}
}

PS: Il me reste la comparaison que je comprends pas comment faire

Message édité par shadow19c le 17-03-2011 à 12:40:04

gilou

Modérateur
Modosaurus Rex

Je dois aller manger la, je reviens dans une petite heure.
A+,

---------------
There's more than what can be linked! -- Le capitaine qui ne veut pas obéir à la carte finira par obéir aux récifs. -- No jab ? No job ! -- (╯°□°)╯︵ ┻━┻

shadow19c

ok merci

gilou

Modérateur
Modosaurus Rex

Je crois que j'ai pigé si c'est ce que tu veux, mais expliques moi si c'est bien ça:

Quand tu as:
my $query_seq = 'DSVIAAMSKRGQDRLHHVIRILAEKGHVKELATAFYGNYTVQDLLDATHXXXXXXXXXXX';
my $sbjct_seq = 'EQAINALQRKSYQKLTRVVDILIESGKVPELVTHYFGNYSIQDLMEACFKLRKSFEKQGR';

Tu veux verifier que quand tu as deux lettres pile l'une en dessous de l'autre, et qui ne sont ni X ni - la premiere a pour position une position donnée dans la liste des positions pour query et l'autre pour position une position donnée dans la liste des positions pour subject, c'est bien ça?

C'est pile l'une en dessous de l'autre ou pas? car ça, ça change tout dans la manière de proceder.

A+,

Message édité par gilou le 17-03-2011 à 14:42:00

---------------
There's more than what can be linked! -- Le capitaine qui ne veut pas obéir à la carte finira par obéir aux récifs. -- No jab ? No job ! -- (╯°□°)╯︵ ┻━┻

shadow19c

Oui , un truc du genre comme la longueur des deux sequences est la meme, donc je regarde si la position de la lettre que je suis entrain de lire est dans la table des position , et pareil pour la lettre den dessous si tous les deux positions osnt dans la table des positions correspondantes je renvoie les deux valeurs, et je continue aisni

gilou

Modérateur
Modosaurus Rex

Un truc de ce style?

Code :

#!usr/bin/perl
use strict;
use warnings;
 
my $query_seq = 'DSVIAAMSKRGQDRLHHVIRILAEKGHVKELATAFYGNYTVQDLLDATHXXXXXXXXXXX';
my $sbjct_seq = 'EQAINALQRKSYQKLTRVVDILIESGKVPELVTHYFGNYSIQDLMEACFKLRKSFEKQGR';
my $q_start = 160;
my $s_start = 264;
my @q_pos = (20, 125, 133, 172, 185, 255);
my @s_pos = (20, 5, 133, 255, 276);
 
my $length = length($query_seq);
 
foreach my $l (@q_pos) {
    next if $l < $q_start;
    last if $l >= $q_start + $length; # ou $l > $q_end si on récupère $q_end dans le fichier
    my $c = substr($query_seq, $l - $q_start, 1); #On récupère le caractère a la position dans la chaine $query_seq
    my $d = substr($sbjct_seq, $l - $q_start, 1); #On récupère le caractère a la position dans la chaine $sbjct_seq
    next if ($c =~ m/[-X]/ or $d =~ m/[-X]/);
    my $k = $l - $q_start + $s_start;
    if (grep {$_ eq $k} @s_pos) {
    print "Found: positions ($l, $k) values ($c, $d) \n" ;
    }
}

> perl test.pl
Found: positions (172, 276) values (D, Q)

Je parcours les positions de la liste @q_pos des query position (et saute celles trop petites ou trop grandes).
Pour une position donnée, je regarde les lettres correspondantes de $query_seq et $sbjct_seq.
Si ces lettres ne sont pas exclues (X et -), je calcule la position de la lettre de $sbjct_seq.
Puis je regarde si cette position est dans @s_pos des subject position.
Si oui, on a un match.

C'est ce genre de chose que tu cherches a faire, ou c'est plus complexe?

A+,

Message édité par gilou le 17-03-2011 à 15:33:55

---------------
There's more than what can be linked! -- Le capitaine qui ne veut pas obéir à la carte finira par obéir aux récifs. -- No jab ? No job ! -- (╯°□°)╯︵ ┻━┻

Publicité

shadow19c

OUI c'est bon je vais essayer de faire cela , par contre j'ai pas compris la partie " (et saute celles trop petites ou trop grandes)."

Message cité 1 fois

gilou

Modérateur
Modosaurus Rex

shadow19c a écrit :

OUI c'est bon je vais essayer de faire cela , par contre j'ai pas compris la partie " (et saute celles trop petites ou trop grandes)."

my @q_pos = (20, 125, 133, 172, 185, 255);
my $q_start = 160;
On saute les trois premières positions (20, 125, 133) puisqu'elles sont plus petites que 160.
Et saute la dernière, 255 qui est plus grande que (160 + la longueur de la chaine -1) soit 219.
A+,

---------------
There's more than what can be linked! -- Le capitaine qui ne veut pas obéir à la carte finira par obéir aux récifs. -- No jab ? No job ! -- (╯°□°)╯︵ ┻━┻

shadow19c

merci pour les explications

shadow19c

Bonjour, merci pour tes explications, mais voila je voudrai faire mon calcul a tres grande echelle:
cest a dire pour un fichier du type

Merci

Message édité par shadow19c le 13-04-2011 à 09:17:28

shadow19c

voila j'ai essaye ceci mais ca ne focntionne pas help me please!!!!!

Code :

#!/usr/bin/perl
use strict;
use warnings;
#Variables
my @positions=(24,48,54,92,137,235,275,324); #Liste des positions que tu souhaites verifier
my @positions2=(26,65,145,189);
my $query_seq;
my $sbjct_seq;
my ($depart_bloc,$fin_bloc)=(0,0);
my ($depart_bloc2,$fin_bloc2)=(0,0);
my $numero_bloc = 1;
open (BLAST_FILE,"<out.bl" ) or die ("Impossible de lire blast.txt\n" );
while(<BLAST_FILE> )
{
if(/Query: (\d+)\s+(.+)\s+(\d+)/) #Ajout de \s+ pour gerer s'il y a plus d'un espacement
{
$depart_bloc=$1; #Index de depart du bloc
$query_seq=$2; #Sequence Query
$fin_bloc=$3; #Index de fin du bloc
}
elsif(/Sbjct: \d+\s+(.+)/)
{
$depart_bloc2=$1;
print $sbjct_seq=$2; #Sequence Sbjct
}
#Si les deux sequences "Query" et "Sbjct" ont ete trouvees, on a un nouveau bloc:
if((defined $query_seq) && (defined $sbjct_seq) && ($query_seq =~ m/\w/) && ($sbjct_seq =~ m/\w/))
{
#Separation des caracteres des sequences dans un tableau
my @tab1 = split(//,$query_seq);
my @tab2 = split(//,$sbjct_seq);
my $length = length(@tab1);
my $r = $depart_bloc;
my $s = $depart_bloc2;
foreach my $l (@positions) {
next if $l < $r ;
last if $l >= $s + $length; # ou $l > $q_end si on récupère $q_end dans le fichier
my $c = substr($query_seq, $l - $r, 1); #On récupère le caractère a la position dans la chaine $query_seq
my $d = substr($sbjct_seq, $l - $r, 1); #On récupère le caractère a la position dans la chaine $sbjct_seq
next if ($c =~ m/[-X]/ or $d =~ m/[-X]/);
my $k = $l - $r + $$s;
if (grep {$_ eq $k} @positions2) {
print "Found: positions ($l, $k) values ($c, $d) \n" ;
}
}
# on vide les variables
$query_seq = '';
$sbjct_seq = '';
}
}

Message édité par shadow19c le 18-03-2011 à 10:21:29

gilou

Modérateur
Modosaurus Rex

Comme je t'ai déjà dit (ben je croyais l'avoir posté, mais la, je vois pas mon message), je regarde cet après midi, une fois que j'aurais effectué des démarcher pour louer un utilitaire (vais tenter le coup avec le nouveau service carrefour)
A+,

Message édité par gilou le 18-03-2011 à 12:51:34

---------------
There's more than what can be linked! -- Le capitaine qui ne veut pas obéir à la carte finira par obéir aux récifs. -- No jab ? No job ! -- (╯°□°)╯︵ ┻━┻

shadow19c

Ok , desole, merci et bon courage

gilou

Modérateur
Modosaurus Rex

Bon, je dois ressortir, mais je vais te donner une idée de comment procéder pour la lecture de ton fichier:
La j'ai mis ton fichier dans un fichiere test "dnadata.txt" pour tester.

Code :

#!/usr/bin/perl
use strict;
use warnings;
 
my $filename = "dnadata.txt";
open my $fh, "<$filename" or die "error opening $filename $!.\n";
my %Query = ( pattern => '^Query:\s(\d+)\s+(.+)\s(\d+)\s*$',
          start   => 0,
              end     => 0,
              line    => "" );
 
my %Sbjct = ( pattern => '^Sbjct:\s(\d+)\s+(.+)\s(\d+)\s*$',
          start   => 0,
              end     => 0,
              line    => "" );
 use constant {
        START       => 0,
        POSTQUERY   => 1,
        POSTSBJCT   => 2, };
my $state = START;
while (<$fh> ) {
  if (/$Query{pattern}/o) {
    if (($state == START) || ($state ==  POSTSBJCT)){
      $Query{start} = $1;
      $Query{end} = $3;
      $Query{line} = $2;
    }
    else {
 
    }
    $state = POSTQUERY;
  }
  if (/$Sbjct{pattern}/o) {
    if ($state ==  POSTQUERY){
      $Sbjct{start} = $1;
      $Sbjct{end} = $3;
      $Sbjct{line} = $2;
      #processBloc(\%Query, \%Sbjct);
    }
    else {
 
    }
    $state = POSTSBJCT;
  }
}
close $fh;

processBloc(\%Query, \%Sbjct); va appeller ce qui a été ecrit hier, faut adapter au ppassage de variables hash par reference
il reste a écrire aussi la gestion d'erreur en lecture du fichier (ordre des données incorrect)
A+,

Message édité par gilou le 18-03-2011 à 18:35:53

---------------
There's more than what can be linked! -- Le capitaine qui ne veut pas obéir à la carte finira par obéir aux récifs. -- No jab ? No job ! -- (╯°□°)╯︵ ┻━┻

shadow19c

Je dois appeler comment le process?

gilou

Modérateur
Modosaurus Rex

Ben c'est une subroutine.

A priori, ça devrait avoir cette tête:

Code :

#!/usr/bin/perl
use strict;
use warnings;
 
my $filename = "dnadata.txt";
open my $fh, "<$filename" or die "error opening $filename $!.\n";
my %Query = ( pattern   => '^Query:\s(\d+)\s+(.+)\s(\d+)\s*$',
          start     => 0,
              end       => 0,
              line      => "",
          positions => [24,48,54,92,137,235,275,324],);
 
my %Sbjct = ( pattern => '^Sbjct:\s(\d+)\s+(.+)\s(\d+)\s*$',
          start   => 0,
              end     => 0,
              line    => "",
          positions => [26,65,145,189],);
 use constant {
        START       => 0,
        POSTQUERY   => 1,
        POSTSBJCT   => 2, };
my $state = START;
while (<$fh> ) {
  if (/$Query{pattern}/o) {
    if (($state == START) || ($state ==  POSTSBJCT)){
      $Query{start} = $1;
      $Query{end} = $3;
      $Query{line} = $2;
    }
    else {
 
    }
    $state = POSTQUERY;
  }
  if (/$Sbjct{pattern}/o) {
    if ($state ==  POSTQUERY){
      $Sbjct{start} = $1;
      $Sbjct{end} = $3;
      $Sbjct{line} = $2;
      processBloc(\%Query, \%Sbjct);
    }
    else {
 
    }
    $state = POSTSBJCT;
  }
}
close $fh;
 
 
sub processBloc {
  my ($Query, $Sbjct) = @_;
  foreach my $l (@{$Query->{positions}}) {
    next if ($l < $Query->{start});
    last if ($l > $Query->{end});;
    my $c = substr($Query->{line}, $l - $Query->{start}, 1);
    my $d = substr($Sbjct->{line}, $l - $Query->{start}, 1);
    next if ($c =~ m/[-X]/ or $d =~ m/[-X]/);
    my $k = $l - $Query->{start} + $Sbjct->{start};
    print "Testing: positions ($l, $k) values ($c, $d): " ;
    if (grep {$_ eq $k} @{$Sbjct->{positions}} ) {
      print "Found a match!\n" ;
    }
    else {
      print "no match.\n" ;
    }
  }
}

A+,

Message édité par gilou le 18-03-2011 à 18:35:24

---------------
There's more than what can be linked! -- Le capitaine qui ne veut pas obéir à la carte finira par obéir aux récifs. -- No jab ? No job ! -- (╯°□°)╯︵ ┻━┻

gilou

Modérateur
Modosaurus Rex

Une version un peu plus aboutie et optimisée en évitant de recopier inutilement les données:

Code :

#!/usr/bin/perl
use strict;
use warnings;
use autodie qw(open close);   # open/close succeed or die
 
# modifiable si le format du fichier change
my $Query_string = '^Query:\s(\d+)\s+(.+)\s(\d+)\s*$';
my $Sbjct_string = '^Sbjct:\s(\d+)\s+(.+)\s(\d+)\s*$';
# peut être passé en parametre au script, etc
my @Query_positions = (24,48,54,92,137,235,275,324);
my @Sbjct_positions = (26,65,145,189);
# fichier de données
my $filename = "dnadata.txt";
 
# On fait tout dans une subroutine histoire d'avoir le tout bien modulaire
# et les parametres importants comme parametres de la subroutine, ce qui
# facilitera l'écriture avec passage des parametres sur la ligne de commande
# du script (l'extension logique de ce script)
processFile(\$filename, \$Query_string, \@Query_positions, \$Sbjct_string, \@Sbjct_positions);
 
sub processFile {
  my ($filename, $Query_string, $Query_positions, $Sbjct_string, $Sbjct_positions) = @_;
  # creation des structures associées a une ligne utile
  my $Query = initStructure($Query_string, $Query_positions);
  my $Sbjct = initStructure($Sbjct_string, $Sbjct_positions);
 
  open my $fh, '<', "$$filename";
  my ($linenum, $bloc, $part) = (0, 0, 0);
  use constant {
    STATE_START  => 0,
    STATE_SCORE  => 1,
    STATE_QUERY  => 2,
    STATE_SBJCT  => 3,
  };
  my $state = STATE_START;
  while (<$fh> ) {
    ++$linenum;
    if (/^Score\s+=/) {
      ++$bloc;
      $part = 0;
      if (($state != STATE_START) && ($state != STATE_SBJCT)) {
    print "Warning: Unexpected Score at line $linenum\n";
      }
      $state = STATE_SCORE;
    }
    if (/${$Query->{pattern}}/o) {
      ++$part;
      adjustData($Query->{data}, $1, $2, $3);
      if (($state != STATE_SCORE) && ($state != STATE_SBJCT)) {
    print "Warning: Unexpected Query at line $linenum\n";
      }
      $state = STATE_QUERY;
    }
    if (/${$Sbjct->{pattern}}/o) {
      adjustData($Sbjct->{data}, $1, $2, $3);
      if ($state != STATE_QUERY) {
    ++$part;
    print "Warning: Unexpected Sbjct at line $linenum\n";
      }
      else {
    processBlocPart($bloc, $part, $Query, $Sbjct);
      }
      $state = STATE_SBJCT;
    }
  }
  close $fh;
  if ($state != STATE_SBJCT) {
    print "Warning: Unexpected end of file\n";
  }
}
 
# cree la structure associee a une ligne de donnees interessantes
sub initStructure {
  my ($pattern, $position) = @_;
  my $hashref = {
         pattern   => $pattern,  #reference sur la chaine de pattern
         positions => $position, #reference sur l'array des positions
         data => {               #reference sur un hash des infos de la ligne
              start => 0,
              end   => 0,
              line  => "",
             },
        };
  return $hashref;
}
 
# remplit les champs d'un hash data passée par reference
sub adjustData {
  my $dataref = shift;
  $dataref->{start} = shift;
  $dataref->{line}  = shift;
  $dataref->{end}   = shift;
}
 
# on a une portion de bloc, on regarde si on a des matches pour les positions cherchees
sub processBlocPart {
  my ($bloc, $part, $Query, $Sbjct) = @_;
  foreach my $l (@{$Query->{positions}}) {
    next if ($l < $Query->{data}->{start});
    last if ($l > $Query->{data}->{end});
    my $c = substr($Query->{data}->{line}, $l - $Query->{data}->{start}, 1);
    my $d = substr($Sbjct->{data}->{line}, $l - $Query->{data}->{start}, 1);
    next if ($c =~ m/[-X]/ or $d =~ m/[-X]/);
    my $k = $l - $Query->{data}->{start} + $Sbjct->{data}->{start};
    print "Testing in bloc $bloc, part $part: positions ($l, $k) values ($c, $d): " ;
    if (grep {$_ eq $k} @{$Sbjct->{positions}} ) {
      print "Found a match!\n" ;
    } else {
      print "no match.\n" ;
    }
  }
}

A+,

---------------
There's more than what can be linked! -- Le capitaine qui ne veut pas obéir à la carte finira par obéir aux récifs. -- No jab ? No job ! -- (╯°□°)╯︵ ┻━┻

shadow19c

Bonjour, merci pour ce programme , par contre il n y a pas un autre moyen d'utiliser use autodie qw(open close); car je suis une ancienne version et comme j'ai pas les droits je ne peux pas mettre a jour:
Par contre voila ce programme est un sous programme que je dois lancer sur un grand:

Merci

Message édité par shadow19c le 13-04-2011 à 09:17:55

gilou

Modérateur
Modosaurus Rex

Citation :

par contre il n y a pas un autre moyen d'utiliser use autodie qw(open close);

ben si tu as pas autodie, faut ajouter a la main la partie avec die après open:
open my $fh, "<$filename" or die "error opening $filename $!.\n";
Par contre tu me dis que tu as pas une version de perl a jour, j’espère que tu as au moins la 5.8 (je suis en 5.12), car si c'est pas le cas, ceux qui sont responsables des logiciels dans ton labo sont des irresponsables! (les open my $fh,... ne sont peut être pas valable avant la 5.8 auquel cas il faut passer par des open FH, ... bref, du code qui ne devrait plus être écrit de nos jours).

Pour la fin de ta question:

Code :

# On fait tout dans une subroutine histoire d'avoir le tout bien modulaire
# et les parametres importants comme parametres de la subroutine, ce qui
# facilitera l'écriture avec passage des parametres sur la ligne de commande
# du script (l'extension logique de ce script)
processFile(\$filename, \$Query_string, \@Query_positions, \$Sbjct_string, \@Sbjct_positions);

Tout est la:
Il suffit que tu passes les paramètres sur la ligne de commande du script, que tu les récupères dans le script (utilisation a priori du module Getopt::Long ou une de ses variantes) et que tu appelles cette routine qui fait tout le boulot.

Par contre, le premier fichier perl donné est
1) avec des fautes de frappe
2) des fichiers ouverts et pas fermés
3) incomplet apparement (on met des trucs dans des hashs, puis on perd ces hashs...)
Donc je peux pas en dire plus.
A la lecture, on voit bien qu'il est simplifiable:

Code :

#!/usr/local/bin/perl
use strict;
use warnings;
 
process_cds("coco_cds" );
process_cds("aster_cds" );
 
open my $desc, '<', "RBH.txt";
while (my $ligne = <$desc> ) {
  my ($id1, $id2) = split(/\t/, $ligne1);
  system("formatdb -o -pT -i DB.pep" );
  system("fastacmd -d DB.pep -s $id1>cv" );
  system("fastacmd -d DB.pep -s $id2>ast" );
  system("bl2seq -i cv -j ast -p blastp -o out.bl -e 1.e-5" );
}
close $desc;
 
 
 
sub process_cds {
  my $filename = shift;
  open my $desc, '<', $filename;
  while (my $line = <$desc> ) {
    next if ($line =~ m/^\#/);
    chomp $line;
    my ( $id, $strand, $coord) = $line =~ m/[\w-]+\t([\w-]+)\t\d+\t([-+])\tORIGINAL JGI\t\d+\t[\#\w\.]+\t([,\d\.]+)/;
    my @exon = split (/,/, $coord);
    my @intron = ($coord =~ m/(\d+,\d+)/g);
    if ($strand eq '-') {
      @exon = reverse(@exon);
      @intron = reverse(@intron);
    }
 
    my $cds;
    my %hash;
    # 3777..3857,4046..4192,4443..4561,4940..5234,5406..5540,5734..5847,6009..6098,6421..6492
    #          324
    
    for my $i (0..$#intron) {
      my ($s, $e) = split(/,/, $intron[$i]);
      my $taille = abs($e-$s+1);
      my ($s2, $e2) = split(/\.\./, $exon[$i]);
      my $taille2 = abs($e2-$s2+1);
      $cds += $taille2;
      my $aa = int($cds/3);
      $hash{$id}{$aa}=$taille;
    }
  }
  close $desc;
}

A+,

Message édité par gilou le 21-03-2011 à 10:59:33

---------------
There's more than what can be linked! -- Le capitaine qui ne veut pas obéir à la carte finira par obéir aux récifs. -- No jab ? No job ! -- (╯°□°)╯︵ ┻━┻

shadow19c

Merci pour ton aide j'ai ajoute la partie que tu as dit mais ca marche pas j'ai un truc

Code :

error opening SCALAR(0x7df2a0) No such file or directory.

et la partie ou je dois automatiser les lignes de commandes j'ai pas compris aussi

merci

gilou

Modérateur
Modosaurus Rex

Citation :

j'ai ajoute la partie que tu as dit

C'est a dire??
A+,

---------------
There's more than what can be linked! -- Le capitaine qui ne veut pas obéir à la carte finira par obéir aux récifs. -- No jab ? No job ! -- (╯°□°)╯︵ ┻━┻

shadow19c

Ben j'ai ajoute open my $fh, "<$filename" or die "error opening $filename $!.\n"; mais maitenant il reconnait pas le fichier et aussi la partie ou je dois afficher a la fin j'ai pas compris

merci pour ton aide

shadow19c

Et jai une version 5.10

gilou

Modérateur
Modosaurus Rex

Citation :

open my $fh, "<$filename" or die "error opening $filename $!.\n";

dans mon code avec processFile?
normal, puisque c'est open my $fh, "<$$filename" or die "error opening $$filename $!.\n";
Je passe le nom de fichier par référence: processFile(\$filename,...
Donc dans processFile, quand on utilise filename, il faut déréférencer, et donc faire $$filename.
A+,

---------------
There's more than what can be linked! -- Le capitaine qui ne veut pas obéir à la carte finira par obéir aux récifs. -- No jab ? No job ! -- (╯°□°)╯︵ ┻━┻

shadow19c

Desole j'ai pas tous compris je suis pas bon en perl:voici le code je dois modifier quoi:ca j'ai un

Code :

Warning: Unexpected Query at line 18

Et la dernier question

Citation :

processFile(\$filename, \$Query_string, \@Query_positions, \$Sbjct_string, \@Sbjct_positions);
Donc m'aintenant je ne sais pas comment je vais pouvoir mettre le programme danns l'ensemble, en sachant que je dois faire intervenir l'id car pour chaque id j'ai construit son hash et ce que je dois a la fin imprimer cest la taille des introns du type:
C169v2-04488 [les differents tailles des introns] Aster-06787[les differents tailles des introns]

J'ai pas c ompris le lien

Code :

#!/usr/bin/perl
use strict;
use warnings;
#use autodie qw(open close); # open/close succeed or die
# modifiable si le format du fichier change
my $Query_string = '^Query:\s(\d+)\s+(.+)\s(\d+)\s*$';
my $Sbjct_string = '^Sbjct:\s(\d+)\s+(.+)\s(\d+)\s*$';
# peut être passé en parametre au script, etc
my @Query_positions = (24,48,54,92,137,235,275,324);
my @Sbjct_positions = (26,65,145,189);
# fichier de données
my $filename = "out.bl";
# On fait tout dans une subroutine histoire d'avoir le tout bien modulaire
# et les parametres importants comme parametres de la subroutine, ce qui
# facilitera l'écriture avec passage des parametres sur la ligne de commande
# du script (l'extension logique de ce script)
processFile(\$filename, \$Query_string, \@Query_positions, \$Sbjct_string, \@Sbjct_positions);
sub processFile {
my ($filename, $Query_string, $Query_positions, $Sbjct_string, $Sbjct_positions) = @_;
# creation des structures associées a une ligne utile
my $Query = initStructure($Query_string, $Query_positions);
my $Sbjct = initStructure($Sbjct_string, $Sbjct_positions);
open my $fh, "<$$filename" or die "error opening $$filename $!.\n";
my ($linenum, $bloc, $part) = (0, 0, 0);
use constant {
STATE_START => 0,
STATE_SCORE => 1,
STATE_QUERY => 2,
STATE_SBJCT => 3,
};
my $state = STATE_START;
while (<$fh> ) {
++$linenum;
if (/^Score\s+=/) {
++$bloc;
$part = 0;
if (($state != STATE_START) && ($state != STATE_SBJCT)) {
print "Warning: Unexpected Score at line $linenum\n";
}
$state = STATE_SCORE;
}
if (/${$Query->{pattern}}/o) {
++$part;
adjustData($Query->{data}, $1, $2, $3);
if (($state != STATE_SCORE) && ($state != STATE_SBJCT)) {
print "Warning: Unexpected Query at line $linenum\n";
}
$state = STATE_QUERY;
}
if (/${$Sbjct->{pattern}}/o) {
adjustData($Sbjct->{data}, $1, $2, $3);
if ($state != STATE_QUERY) {
++$part;
print "Warning: Unexpected Sbjct at line $linenum\n";
}
else {
processBlocPart($bloc, $part, $Query, $Sbjct);
}
$state = STATE_SBJCT;
}
}
close $fh;
if ($state != STATE_SBJCT) {
print "Warning: Unexpected end of file\n";
}
}
# cree la structure associee a une ligne de donnees interessantes
sub initStructure {
my ($pattern, $position) = @_;
my $hashref = {
pattern => $pattern, #reference sur la chaine de pattern
positions => $position, #reference sur l'array des positions
data => { #reference sur un hash des infos de la ligne
start => 0,
end => 0,
line => "",
},
};
return $hashref;
}
# remplit les champs d'un hash data passée par reference
sub adjustData {
my $dataref = shift;
$dataref->{start} = shift;
$dataref->{line} = shift;
$dataref->{end} = shift;
}
# on a une portion de bloc, on regarde si on a des matches pour les positions cherchees
sub processBlocPart {
my ($bloc, $part, $Query, $Sbjct) = @_;
foreach my $l (@{$Query->{positions}}) {
next if ($l < $Query->{data}->{start});
last if ($l > $Query->{data}->{end});
my $c = substr($Query->{data}->{line}, $l - $Query->{data}->{start}, 1);
my $d = substr($Sbjct->{data}->{line}, $l - $Query->{data}->{start}, 1);
next if ($c =~ m/[-X]/ or $d =~ m/[-X]/);
my $k = $l - $Query->{data}->{start} + $Sbjct->{data}->{start};
print "Testing in bloc $bloc, part $part: positions ($l, $k) values ($c, $d): " ;
if (grep {$_ eq $k} @{$Sbjct->{positions}} ) {
print "Found a match!\n" ;
} else {
print "no match.\n" ;
}
}
}

Message édité par shadow19c le 21-03-2011 à 11:21:24

gilou

Modérateur
Modosaurus Rex

>> Warning: Unexpected Query at line 18
Si tu as ça, ça veut dire que ton fichier a une ligne Query (la 18e de ton fichier): qui n'est pas précédée d'une ligne score ou d'une ligne subject, ce qui ne devrait pas arriver au vu des exemples que tu m'avais donné.
Tu peux poster les 25 premières lignes du fichier blast?

Citation :

Donc m'aintenant je ne sais pas comment je vais pouvoir mettre le programme danns l'ensemble, en sachant que je dois faire intervenir l'id car pour chaque id j'ai construit son hash et ce que je dois a la fin imprimer cest la taille des introns du type:

Et quel est le lien entre cet id et ce hash avec les positions etc?

A+,

Message édité par gilou le 21-03-2011 à 11:27:10

---------------
There's more than what can be linked! -- Le capitaine qui ne veut pas obéir à la carte finira par obéir aux récifs. -- No jab ? No job ! -- (╯°□°)╯︵ ┻━┻

shadow19c

voila un exemple de fichier blast vu que ca change a chaque fois

Message cité 1 fois
Message édité par shadow19c le 13-04-2011 à 09:18:12

gilou

Modérateur
Modosaurus Rex

shadow19c a écrit :

voila un exemple de fichier blast vu que ca change a chaque fois

Code :

Query= lcl|C169v2-04459 jgi|Coc_C169_1|41999|fgenesh1_pg.8_#_47
(774 letters)
>lcl|Aster-06520 geneId:"fgenesh1_pg.00135_#_11" protId:"41398"
coord:[scaffold_00135;strand="+";exons="97472..97595,
97871..97990,98255..98385,98523..98600,99137..99242,
100066..100208,101409..101588,102496..102570,
103096..103350,104224..104473,104717..105016,
106783..107570,107866..107976,108778..109024,
109996..110054,110100..110270,111087..111188"]
Length = 1079
Score = 37.7 bits (86), Expect = 3e-06
Identities = 22/68 (32%), Positives = 31/68 (45%), Gaps = 2/68 (2%)
Query: 691 PLAEYKTESDLRKALRAALIPMVNSQQGTSHKSATQ--VLAQGTQPTWWPLDKWGKKILD 748
P+A + T DL K +R A+ V Q+ A + V T P WWPL W K L
Sbjct: 1011 PIASWGTLKDLSKVVRRAVQEWVVEQRAARGLKADRGSVYQGNTPPAWWPLPVWDNKQLH 1070
Query: 749 RRWKALEA 756
+ ++A
Sbjct: 1071 TKAACVKA 1078
Lambda K H
0.306 0.123 0.346
Gapped
Lambda K H
0.267 0.0410 0.140
Matrix: BLOSUM62
Gap Penalties: Existence: 11, Extension: 1
Number of Sequences: 1
Number of Hits to DB: 1921
Number of extensions: 101
Number of successful extensions: 2
Number of sequences better than 1.0e-05: 1
Number of HSP's gapped: 3
Number of HSP's successfully gapped: 1
Number of extra gapped extensions for HSPs above 0.0: 1
Length of query: 774
Length of database: 1079
Length adjustment: 43
Effective length of query: 731
Effective length of database: 1036
Effective search space: 757316
Effective search space used: 757316
Neighboring words threshold: 11
Window for multiple hits: 40
X1: 16 ( 7.1 bits)
X2: 38 (14.6 bits)
X3: 64 (24.7 bits)
S1: 42 (21.6 bits)
S2: 82 (36.2 bits)

C'est celui qui t'a donné le warning?
Parce que pour moi la, j'ai pas le moindre warning.
A+,

---------------
There's more than what can be linked! -- Le capitaine qui ne veut pas obéir à la carte finira par obéir aux récifs. -- No jab ? No job ! -- (╯°□°)╯︵ ┻━┻

shadow19c

Ben oue je pense que quand tu fais copier coller ca marche, je comprends pas!!!
Par contre peux tu m'aider a faire le lien entre les deux programmes et faire l'affichage
La je dois enlever la partie no match et tout ca juste afficher les tailles des introns c'est tout

merci

Message cité 1 fois
Message édité par shadow19c le 21-03-2011 à 11:39:35

gilou

Modérateur
Modosaurus Rex

shadow19c a écrit :

Ben oue je pense que quand tu fais copier coller ca marche, je comprends pas!!!

Il va falloir que tu imprimes la valeur de $state:
$state = STATE_SCORE;
print "state = score\";
chaque fois qu'on fait un $state =
pour voir ce qu'on a eu avant le message de warning.

shadow19c a écrit :

Citation :

La je dois enlever la partie no match et tout ca juste afficher les tailles des introns c'est tout

merci

Ben oui, je vais quand même pas tout faire a ta place.

Citation :

Par contre peux tu m'aider a faire le lien entre les deux programmes et faire l'affichage

Ben vu que tes explications sont vaseuses sur la question, pour le moment, je peux pas.
A+,

Message édité par gilou le 21-03-2011 à 12:07:39

---------------
There's more than what can be linked! -- Le capitaine qui ne veut pas obéir à la carte finira par obéir aux récifs. -- No jab ? No job ! -- (╯°□°)╯︵ ┻━┻

gilou

Modérateur
Modosaurus Rex

Au fait, pour autodie, rien a voir avec la version, c'est juste que le module est pas installé par défaut dans ton installation, il faut l'installer avec cpan (ou ppm d'active state si tu es sous windows et utilise leur perl)
A+,

---------------
There's more than what can be linked! -- Le capitaine qui ne veut pas obéir à la carte finira par obéir aux récifs. -- No jab ? No job ! -- (╯°□°)╯︵ ┻━┻

shadow19c

Oui pardon, en fait j'ai pas compris la partie du module Getopt::Long, car je dois le mettre dans quelle programme a priori le deuxieme celui qui fait la recherche, mais cest pour lui dire que les positons ce sont les $aa du premier code je dois modifier le process??

merci

gilou

Modérateur
Modosaurus Rex

Getopt::Long si tu vas voir la doc, tu devrais comprendre. c'est un module qui récupère des arguments passé en ligne de commande de manière plus intelligente que passer par @ARGV.

Pour le reste, tu n'as toujours pas expliqué le lien entre ce que tu fais avec tes fichier cds et le fichier blast. Qu'est ce que tu veux lier comme info entre les deux? Tes tables de positions sont calculées a partir des cds? ou quoi d'autre?

A+,

Message édité par gilou le 21-03-2011 à 13:12:52

---------------
There's more than what can be linked! -- Le capitaine qui ne veut pas obéir à la carte finira par obéir aux récifs. -- No jab ? No job ! -- (╯°□°)╯︵ ┻━┻

shadow19c

Le fichier blast contient les ID's ce qui permet de faire le blast Cv-***(query) sur aster-***(subject), donc quand j'ai construit le hash du debut (premier programme, j'ai cree pour chaque Id une ou plusieurs positions et aussi j'ai calcule la taille des introns.
Ce qui permet pour le programme deux, pour chaque Id aller chercher ses positions et faire la recherche dans le blast comme on le fait et si il y a un match je renvoi la taille des introns qui peuvent etre plusieurs , donc cest pour cela que je voulais savoir si je peux pas incorporer les deux programmes en un seul.

merci

Message édité par shadow19c le 21-03-2011 à 13:32:00

gilou

Modérateur
Modosaurus Rex

Citation :

donc cest pour cela que je voulais savoir si je peux pas incorporer les deux programmes en un seul.

Il vaut mieux alors faire dans le modulaire.

Tu transformes le second fichier en module perl:

Code :

#!/usr/bin/perl
package dnadata;  #### ou un autre nom adapte ###
use strict;
use warnings;
#use autodie qw(open close);   # open/close succeed or die
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
require Exporter;
 
@ISA = qw(Exporter AutoLoader);
@EXPORT = qw(processFile);
$VERSION = '0.1';
 
########### change pas  a partir d'ici #############
 
sub processFile {
  my ($filename, $Query_string, $Query_positions, $Sbjct_string, $Sbjct_positions) = @_;
  # creation des structures associées a une ligne utile
  my $Query = initStructure($Query_string, $Query_positions);
  my $Sbjct = initStructure($Sbjct_string, $Sbjct_positions);
...................
    if (grep {$_ eq $k} @{$Sbjct->{positions}} ) {
      print "Found a match!\n" ;
    } else {
      print "no match.\n" ;
    }
  }
}
############ fin de ce qui ne changeait pas
 
1;
__END__

Tu sauves tout ça sous un nom de fichier dnadata.pm (pas .pl) (et tu remplaces dnadata par le nom adapté que tu auras choisi, il faut que ce soit le même que celui du package dans le fichier)

Maintenant, si tu es dans ton programme principal, tu vas pouvoir faire:

Code :

use dnadata; #avec les autres uses de ton programme (si tu as un autre nom de package que dnadata faut changer ici)
 
.........................
# valeurs qui viennes de ton programme principal ?
# modifiable si le format du fichier change
my $Query_string = '^Query:\s(\d+)\s+(.+)\s(\d+)\s*$';
my $Sbjct_string = '^Sbjct:\s(\d+)\s+(.+)\s(\d+)\s*$';
# 
my @Query_positions = (24,48,54,92,137,235,275,324);
my @Sbjct_positions = (26,65,145,189);
# 
my $filename = "dnadata1.txt";
 
processFile(\$filename, \$Query_string, \@Query_positions, \$Sbjct_string, \@Sbjct_positions); # va appeler la fonction du module dnadata

et ça marchera.
Notes qu'il faudra que le fichier dnadata.pm (ie celui du module dnadata) soit dans le même répertoire que celui du programme principal.

A+,

Message édité par gilou le 21-03-2011 à 14:06:34

---------------
There's more than what can be linked! -- Le capitaine qui ne veut pas obéir à la carte finira par obéir aux récifs. -- No jab ? No job ! -- (╯°□°)╯︵ ┻━┻

shadow19c

En fait quest ce que je dois modifier dans le programme deux, je comprends pas.
JE voulais savoir ca serait pas mieux de tout mettre dans le programme un qui fqit les hash apres la creation du fichier out.bl direct je fais la recherche?
Jai une erreur Missing right curly or square bracket at dnadata.pm line 117, at end of line
syntax error at dnadata.pm line 117, at EOF
Compilation failed in require at test3.pl line 4.
BEGIN failed--compilation aborted at test3.pl line 4.

Message cité 1 fois
Message édité par shadow19c le 21-03-2011 à 14:20:17

Publicité

Page : 1 2

Page Suivante

Page Précédente

Haut de page

FORUM HardWare.fr

Programmation

Perl

[perl] Probleme double lecture

Sujets relatifs
[resolu] problème d'injection SQL, doctrine orm	[Resolu][perl tk] caractère spéciaux dans une listbox (genre àéè...)
Probleme sur href et mailto	[Résolu] Problème clause is ambiguous
Probleme avec state	Apache + SVN, problème d'authentification
Macro Excel - Problème avec ActiveCell.Font.ColorIndex	probleme avec un JAVA suivant le serveur
Plus de sujets relatifs à : [perl] Probleme double lecture

Page générée en 0.413 secondes