Problème de boucle dans les colonnes en Perl

La question semble claire, conserver les données avant : dans chaque colonne (sauf dans la première). Mais ensuite, je suis un peu confus par la tentative de code, qui passe inutilement par des modèles spécifiques pour les colonnes.

Voici une interprétation simple de ce qui est décrit

use warnings;
use strict;
use feature 'say';

my $header_line = <>;   # drop the first line

while (<>) {            # line by line from files given on cmdline, or STDIN
    chomp;

    my ($fmt_col, @cols) = split /\t/;   # (but sample has spaces, not tabs)

    s/(.*?):.*/$1/ for @cols;            # keep up to (first) : in each field
    
    say join "\t", $fmt_col, @cols;      # print fields joined by tabs
}

Le

code> lit toutes les lignes de tous les fichiers donnés sur la ligne de commande, ou STDIN ; alors soumettez un nom de fichier à traiter sur la ligne de commande lors de l'exécution de ce programme.

Notez que l'exemple publié n'a pas d'onglets, mais plutôt d'espaces; donc le code ci-dessus échouera si on le copie-colle. Changez les espaces en tabulations à tester, ou changez split / \ t /; en split; (afin d'utiliser sa valeur par défaut pour fractionner, qui correspond à n'importe quelle quantité d'espace ).

Tous les champs autres que le premier sont modifiés de sorte que seuls les caractères jusqu'au premier : restent.

Ceci est fait en utilisant le fait que chaque l'élément traité dans la boucle foreach ("topicalizer") est aliasé sur l'élément actuellement traité. Ainsi, lorsque l'expression régulière s /// change, l'élément correspondant de @cols est changé. Si cela semble trop cuisant à digérer, veuillez l'écrire gentiment et lentement.

Si quelque chose d'autre est réellement nécessaire à faire, veuillez clarifier.

Je pense avoir résolu le problème. J'ai supprimé foreach mes $ lines (@colsplit) { et maintenant ça marche! Code ci-dessous:

#!/usr/bin/perl
use strict;

my $inputfile1 = $ARGV[0];
open (FILE1, $inputfile1) or die "Uh oh.. unable to find file $inputfile1"; ##Opens input file

my @file1 = <FILE1>; #loads inputfile1 data into array
close FILE1;


my (@colsplit, @genotypes1, @genotypes2, @genotypes3, @joined); 
foreach my $line(@file1) { ## process each line, splitting columns and move onto next line
    @colsplit = split("\t", $line);
        push (@joined, $colsplit[0]);
                if ($colsplit[1] =~ m/(^0\/1)/ || $colsplit[1] =~ m/(^0\/0)/ || $colsplit[1]=~ m/(^1\/0)/ || $colsplit[1] =~ m/(^1\/1)/ || $colsplit[1] =~ m/(^.\/.)/) {
                    push (@genotypes1, $1);
                    }
                    if ($colsplit[2] =~ m/(^0\/1)/ || $colsplit[2] =~ m/(^0\/0)/ || $colsplit[2] =~ m/(^1\/0)/ || $colsplit[2] =~ m/(^1\/1)/ || $colsplit[2] =~ m/(^.\/.)/) {
                    push (@genotypes2, $1);
                    }
                    if ($colsplit[3] =~ m/(^0\/1)/ || $colsplit[3] =~ m/(^0\/0)/ || $colsplit[3] =~ m/(^1\/0)/ || $colsplit[3] =~ m/(^1\/1)/ || $colsplit[3] =~ m/(^.\/.)/) {
                    push (@genotypes3, $1); 
                }
            }



my $i = 0;
foreach my $line(@joined) {
    if ($line =~ m/GT/) {
print "$line\t$genotypes1[$i]\t$genotypes2[$i]\t$genotypes3[$i]\n";
$i++;
    }}

Merci à @zdim en particulier de m'avoir montré une solution plus élégante. E

Une manière possible est d'utiliser le modificateur de continuation ( c code >) de la correspondance d'expressions régulières. Cela provoque le démarrage d'une opération de correspondance à partir de l'endroit où la dernière a trouvé une correspondance. Comme ça, chaque champ d'une ligne peut être traité.

#!/usr/bin/perl

use strict;
use warnings;

my $fh;
$ARGV[0] && open($fh, $ARGV[0]) || die();

# discard first line;
<$fh>;

foreach my $line (<$fh>) {
  chomp($line);

  # capture every non tab character from the beginning of the line;
  # globally match the pattern repeatedly in the string (g modifier)
  # keep the current position during repeated matching (c modifier);
  $line =~ m/^([^\t]*)/gc;
  print("$1");

  # capture every non colon character after a tab character;
  # globally match the pattern repeatedly in the string (g modifier);
  # keep the current position during repeated matching (c modifier);
  while ($line =~ m/\t([^:]*)/gc) {
    print("\t$1");
  }

  print("\n");
}