Foro - Perl en Español

por **Alfumao** » 2023-07-17 03:52 @203

Buenos días a todos (y en especial a explorer).

Tengo un problema para capturar unos valores con una expresión regular que tiene como base la aparición de dos saltos de línea consecutivos.

He de capturar 2 valores de una tabla incluida en un archivo con formato .txt y la única forma de hacerlo es, primero detectar un doble salto de línea y después capturar los valores, ya que la tabla no tiene un número de líneas fijo, y los valores que necesito se encuentran en la última línea.

Os dejo a continuación la expresión regular (que generé y no me está funcionando) y un ejemplo de la tabla a la que me refiero.

$_=~/([\d+\,]+)\s+([\d+\,]+\.\d+)\r\n\r\n/)

Tabla (valores a capturar en negrita):

begin 1,699,932 10,136.45
1 1,712,388 12,455.32
2 1,712,605 12,484.85
3 1,712,611 12,513.51

Ojala podáis ayudarme, porque aunque he usado "comprobadores de expresiones regulares" online que me dicen que hace "match", en mi código no parece funcionar...

Me extraña que necesites poner '\r' en la expresión regular. Sólo es necesario cuando el texto que estamos analizando proviene de un sistema operativo distinto de en el que estamos.

O sea... si la cuestión es capturar dos valores de una tabla, basta con pedir a split() que parta la línea en columnas, y nos quedaremos con las dos últimas.

Pero... hay una condición más... Deben existir dos saltos de línea.

Si tenemos todo el texto almacenado en una variable, es fácil de encontrar:

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

#!/usr/bin/perl
use v5.24;
 
my $texto = 'begin 1,699,932 10,136.45
1 1,712,388 12,455.32
2 1,712,605 12,484.85
3 1,712,611 12,513.51
 
';
 
say "[$texto]";
 
$texto =~ /(\S+) \s+ (\S+) \n \n/sx;
 
say "[$1] [$2]";  # [1,712,611] [12,513.51]
Coloreado en 0.003 segundos,  usando GeSHi 1.0.8.4

por **Alfumao** » 2023-07-26 13:23 @599

¡Hola, explorer!

El tema es un poco más complejo en su conjunto.

Tengo que extraer los valores de un archivo que contiene líneas de info, tablas con info, y líneas sin info (te pego un ejemplo debajo). El tema es que mis colaboradores me piden extraer info de todos lados y se me está haciendo un poco bola el asunto...

Sintáxis: [ Descargar ] [ Ocultar ]

Using text Syntax Highlighting

Polishing miniasm assembly with Racon (2023-07-08 00:32:20)

-----------------------------------------------------------

    Unicycler now uses Racon to polish the miniasm assembly. It does multiple rounds of polishing to get the best consensus. Circular unitigs are rotated between rounds such that all parts (including the ends) are polished well.

Saving to /storage/Filtered_reads/NKC1231_LRassembly/miniasm_assembly/racon_polish/polishing_reads.fastq:

  38,855 long reads

Polish       Assembly          Mapping

round            size          quality

begin       1,671,271        29,207.18

1           1,685,412        33,629.12

2           1,685,573        33,654.73

3           1,685,628        33,682.91

Best polish: /storage/Filtered_reads/NKC1231_LRassembly/miniasm_assembly/racon_polish/016_rotated.fasta

Saving /storage/Filtered_reads/NKC1231_LRassembly/miniasm_assembly/13_racon_polished.gfa

Saving /storage/Filtered_reads/NKC1231_LRassembly/003_racon_polished.gfaColoreado en 0.000 segundos,  usando GeSHi 1.0.8.4

La historia es que me atasco en dos cosas, principalmente:

- Cómo extraer la info de las líneas 2 y 3 de la tabla anterior

- Extraer la siguiente tabla completa en otro archivo (empieza en "Segment" y acaba en "\n\nAssembly") pero por más que intento capturar el rango y quedarme con la tabla no me funciona ninguna expresión regular de las que he probado, p. e.:

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

/(?<=Segment)[\S\s](*?)(?=\n\nAssembly)/
Coloreado en 0.001 segundos,  usando GeSHi 1.0.8.4

Sintáxis: [ Descargar ] [ Ocultar ]

Using text Syntax Highlighting

    Any completed circular contigs (i.e. single contigs which have one link connecting end to start) can have their start position changed without altering the sequence. For consistency, Unicycler now searches for a starting gene (dnaA or repA) in each such contig, and if one is found, the contig is rotated to start with that gene on the forward strand.

Segment   Length      Depth   Starting gene   Position   Strand   Identity   Coverage

      1   1,686,067   1.00x   none found                                             

      2      29,404   2.12x   none found                                             

Assembly complete (2023-07-08 00:57:51)

---------------------------------------

Saving /storage/ONT/NETRAM_Campy/Filtered_reads/NKC1234_LRassembly/assembly.gfaColoreado en 0.000 segundos,  usando GeSHi 1.0.8.4

Disculpa tanto rollo, pero es que estoy rozando la desesperación, jajajaja

por **explorer** » 2023-07-26 23:14 @010

Esta es una solución para el primer caso:

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

#!/usr/bin/perl
 
use v5.24;
use Path::Tiny;
 
my $archivo = path("kk.txt")->slurp;   # leemos el contenido
#say $archivo;
 
# Buscar por la tabla Polish
# Tratamos archivo como una sola cadena (/s), y
# las anclas ^ y $ detectan posiciones en cualquier parte del texto (/m)
if ($archivo =~ /^(Polish\s+Assembly.+?)\n\n/ms) {
    say "[$1]";
    my $tabla = $1;
 
    # Extraer las dos últimas líneas de la tabla
    # Usamos un truco muy sucio: metemos el texto, separado por líneas,
    # en un array, y nos quedamos con los dos últimos valores
    my @tabla = split /\n/, $tabla;
    say "Dos últimas líneas:\n$tabla[-2]\n$tabla[-1]";
}
Coloreado en 0.002 segundos,  usando GeSHi 1.0.8.4

Y este para el segundo caso. No sabemos si forman parte del mismo archivo, pero se pueden aplicar las dos soluciones a la vez, si es el caso.

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

#!/usr/bin/perl
 
use v5.24;
use Path::Tiny;
 
my $archivo = path("kk.txt")->slurp;   # leemos el contenido
#say $archivo;
 
# Buscar por la tabla Segment
# La línea comienza por "Segment Length" y termina justo antes de dos avances de línea
my($tabla) = $archivo =~ /^(Segment\s+Length.+?)\n\n/ms;
 
say "[$tabla]";
Coloreado en 0.001 segundos,  usando GeSHi 1.0.8.4

por **Alfumao** » 2023-07-28 03:15 @177

Hola de nuevo, explorer.

He tenido algunos problemillas con la identificación en el foro y por eso el retraso en contestar...

Te paso un ejemplo de un archivo tipo donde efectivamente se encuentran a la vez todos esos datos que quiero obtener (como la negrita parece no funcionar bien te describo tras el texto principal los datos específicos que no puedo conseguir:

Sintáxis: [ Descargar ] [ Ocultar ]

Using text Syntax Highlighting

Loading reads (2023-07-08 00:29:15)

-----------------------------------

38,855 / 38,855 (100.0%) - 254,724,562 bp

Assembling contigs and long reads with miniasm (2023-07-08 00:29:21)

--------------------------------------------------------------------

Saving to /storage/C1231_LRassembly/miniasm_assembly/01_assembly_reads.fastq:

  38,855 long reads

Finding overlaps with minimap... 

success

  5,947,215 overlaps

Assembling reads with miniasm... 

success

  320 segments, 320 links

Saving /storage/C1231_LRassembly/miniasm_assembly/11_branching_paths_removed.gfa

Merging segments into unitigs:

  1 circular unitig

  total size = 1,671,271 bp

Saving /storage/C1231_LRassembly/miniasm_assembly/12_unitig_graph.gfa

Saving /storage/C1231_LRassembly/002_unitig_graph.gfa

Polishing miniasm assembly with Racon (2023-07-08 00:32:20)

-----------------------------------------------------------

    Unicycler now uses Racon to polish the miniasm assembly. It does multiple rounds of polishing to get the best consensus. Circular unitigs are rotated between rounds such that all parts (including the ends) are polished well.

Saving to /storage/C1231_LRassembly/miniasm_assembly/racon_polish/polishing_reads.fastq:

  38,855 long reads

Polish       Assembly          Mapping

round            size          quality

begin       1,671,271        29,207.18

1           1,685,412        33,629.12

2           1,685,573        33,654.73

3           1,685,628        33,682.91

Best polish: /storage/C1231_LRassembly/miniasm_assembly/racon_polish/016_rotated.fasta

Saving /storage/C1231_LRassembly/miniasm_assembly/13_racon_polished.gfa

Saving /storage/C1231_LRassembly/003_racon_polished.gfa

Rotating completed replicons (2023-07-08 00:38:35)

--------------------------------------------------

    Any completed circular contigs (i.e. single contigs which have one link connecting end to start) can have their start position changed without altering the sequence. For consistency, Unicycler now searches for a starting gene (dnaA or repA) in each such contig, and if one is found, the contig is rotated to start with that gene on the forward strand.

Segment   Length      Depth   Starting gene   Position   Strand   Identity   Coverage

      1   1,685,628   1.00x   none found                                             

      2     585,617   1.00x   none found   

Assembly complete (2023-07-08 00:39:06)

---------------------------------------

Saving /storage/C1231_LRassembly/assembly.gfa

Coloreado en 0.000 segundos,  usando GeSHi 1.0.8.4

Datos 1. Las dos últimas líneas de esta tabla (el número de líneas es variable en cada archivo de resultados):

Sintáxis: [ Descargar ] [ Ocultar ]

Using text Syntax Highlighting

Polish       Assembly          Mapping

round            size          quality

begin       1,671,271        29,207.18

1           1,685,412        33,629.12

2           1,685,573        33,654.73

3           1,685,628        33,682.91Coloreado en 0.000 segundos,  usando GeSHi 1.0.8.4

Datos 2. Esta tabla completa (como en el caso anterior el número de líneas es variable en cada archivo de resultados)

Sintáxis: [ Descargar ] [ Ocultar ]

Using text Syntax Highlighting

Segment   Length      Depth   Starting gene   Position   Strand   Identity   Coverage

      1   1,685,628   1.00x   none found                                             

      2     585,617   1.00x   none found Coloreado en 0.000 segundos,  usando GeSHi 1.0.8.4

La idea sería tener todo el proceso en un mismo código.

Por ahora he conseguido obtener todos los datos anteriores que necesito además de la última línea de la primera tabla con este código:

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

#!usr/bin/perl -w
use strict;
use Getopt::Long;
 
my ($path, $study);
GetOptions(
    'path=s'          => \$path,
    );
    
print "$path\n";
chdir $path or die "ERROR: Unable to enter $path: $!\n";
opendir (TEMP , ".");
my @files = readdir (TEMP);
closedir TEMP;
 open  OUT,'>'."Unicycler_logs_parsed.tsv" or die "ERROR: Unable to open outfile $!\n";
 print OUT "Sample\tInput_Reads\tInput_bp\tCircular_contigs\tLinear_contigs\tTotal_size_bp_before_polish\tmax_score_after_polish\tfinal_size_after_polish\n"; 
         
 
for my $file (@files) {
 
my$inputreads;
my$perc;
my$inputbp;
my$tsizbpol;
my$linear=0;
my$circ=0;
 my ( $inputreads, $perc, $inputbp, $tsizbpol, $found, $mAxssize, $qualAssize );
 
    if($file=~/(\w+)\_LRassembly.unicycler.log/){
          my$sample=$1;
          print OUT "$sample\t";
          print "Sample is $sample\n";
 
          open(INFILE,"$file") or die ("ERROR: Unable to open Log to parse file $!\n");
          chomp(my @data = <INFILE>);
          print"Parsing $file\n";
          my$nc=0;
 
 
        for (@data) {
 
            if($_=~/^([\d+\,]+)\s\/\s([\d+\,]+)\s\(([\d+\.]+)\%\)\s\-\s([\d+\,]+)\sbp/){
                    $inputreads=$1;
                    print "IN $inputreads\n";
                    $perc=$3;
                    print "Perc $perc\n";
                    $inputbp=$4;
                    print "INbp $inputbp\n";
            }
            if($_=~/total size\s\=\s([\d+\,]+)\sbp/){
                    $tsizbpol=$1;
                    print "Total Size before polish $tsizbpol $!\n";
            }
            if($_=~/(\d+)\s+linear unitig/ || /(\d)\s+linear unitigs/){
                   $linear=$1;
                   print "linear unitigs $circ $!\n";
            }
           if($_=~/(\d+)\s+circular unitig/ || /(\d)\s+circular unitigs/){
                    $circ=$1;
                    print "circular unitigs $circ $!\n";
            }
   
    }
         print OUT ("$inputreads\t$inputbp\t$linear\t$circ\t$tsizbpol\t") or die ("ERROR: Unable to write log parsing file $!\n");    
         open( my $INFILE, "<", $file )or die( "ERROR: Can't open log file `$file`: $!\n" );  # Incl file name
 
    
        while ( <$INFILE> ) {
              s/\s+\z//;  # Remove line endings. Handles both `\n` and `\r\n`.
             if ( $found && !length( $_ ) ) {
                 print "MaxAssemblySize $mAxssize\n";
                 print "QualAssembly $qualAssize\n";
                 print OUT ("$qualAssize\t$mAxssize\n") or die ("ERROR: Unable to write log parsing file $!\n");
                 }
 
                $found = ( $mAxssize, $qualAssize ) = /([\d+\,]+)\s+([\d+\,]+\.\d+)\z/;
 
        }
 
     }
}
 
Coloreado en 0.003 segundos,  usando GeSHi 1.0.8.4

¿Cómo lo ves?

por **explorer** » 2023-07-28 14:59 @666

Probando, sale esto:

Sintáxis: [ Descargar ] [ Ocultar ]

Using text Syntax Highlighting

Sample  Input_Reads     Input_bp        Circular_contigs        Linear_contigs  Total_size_bp_before_polish     max_score_after_polish  final_size_after_polish

inicio  38,855          254,724,562     0                       1               1,671,271                       33,682.91               1,685,628Coloreado en 0.000 segundos,  usando GeSHi 1.0.8.4

Salvo el detalle que Circular_contigs y Lineas_contigs están al revés, se supone que están todos los datos que necesitas, ¿no?

No entiendo lo de "las dos últimas líneas de la tabla". ¿Cómo tendrían que salir esas dos líneas? Yo lo que veo es que capturas las dos últimas columnas, de la última línea.

por **Alfumao** » 2023-07-29 02:27 @144

Hola, explorer.

Como bien dices, en el script capturo las 2 últimas columnas de la última línea, pero ahora me piden que capture también esas mismas columnas en la línea anterior y después compare los valores de max_score_after_polish de ambas líneas, para así seleccionar e imprimir en la tabla de salida los valores de la línea que tenga ese parámetro más alto...

Y luego falta también lo de la captura de la tabla del final, que es otro quebradero de cabeza.

Cada día una cosa nueva, me solicitan...

por **explorer** » 2023-07-29 18:46 @823

Primero, detalles basados en el código que has mostrado antes.

Línea 1: falta un '/' delante de usr.
Línea 1: no es recomendable usar "-w" ya que eso activa las advertencias incluso en los módulos externos. Mejor usar "use warnings;".
Línea 1: agrega la línea 'use warnings;' para que Perl te avise de más problemas.
Líneas 15, 16, 31... (todas las que son OUT). Lo mejor sería acumular la información y mostrarla al final con el formato que nos piden, pero debemos saberlo. Mientras tanto, tendrás que acomodarte a lo que te piden
La línea 27 genera advertencias porque estás declarando las mismas variables dos veces.
Línea 35. Ya que te has leído el archivo entero, y luego lo vuelves a abrir en la línea 65, es recomendable poner un 'close INFILE;'.
Línea 56. Hay un error con la variable. Debe ser $linear.
Línea 64. El orden de impresión de $linear y $circ es incorrecto.
Bucle 68 a 78. Con ese bucle capturas la información de la última línea, pero no de las anteriores. La clave está en la comprobación length($_) que marca la primera línea en blanco justo después de la última línea. Ya que vas a necesitar recordar varias líneas, casi mejor hacer un bucle que las lea todas, y cuando termines, accedes a las últimas con los índices [-2] y [-1], como te indicaba en mi anterior respuesta.

Un comentario... el formato del log sigue una serie de reglas sencillas por las que es fácil "partirlo". Veo que son distintas secciones que comienzan con un título, seguido por una línea de guiones, y termina con 3 o más avances de línea consecutivos, o el final de archivo. Esto es más que suficiente para poder procesar todo el registro y sacar información.

Esta es mi solución:

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

#!/usr/bin/perl
#
# Procesar registro generado por Unicycler
#
# Joaquín Ferrero, julio 2023
#
# Primera versión: 20230729
#
 
use v5.24;              # mínima versión de Perl
use strict;             # programación estricta
use warnings;           # activar advertencias
 
use Getopt::Long;
use autodie;            # para toda la E/S
 
## Constantes
my $PLANTILLA_INFORMES  = qr/(\w+)\_LRassembly[.]unicycler[.]log/;
my $ARCHIVO_SALIDA      = 'Unicycler_logs_parsed.tsv';
 
#         1         2         3         4         5         6         7         8         9        10        11        12        13        14        15        16
#1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890
#Sample   Input_Reads     Input_bp      Circular_contigs    Linear_contigs      Total_size_bp_before_polish   max_score_after_polish   final_size_after_polish
#inicio   38,855          254,724,562   0                   1                   1,671,271                     33,682.91                1,685,628
my @CABECERAS        = qw(Sample Input_Reads Input_bp Circular_contigs Linear_contigs Total_size_bp_before_polish max_score_after_polish final_size_after_polish);
my @ANCHOS_CABECERAS = qw(7      15          15       23               15             31                          23                     23                     );
my $FORMATO_SALIDA   = join(" ", map { "%-${_}s" } @ANCHOS_CABECERAS) . "\n";
 
my $DEFINES          = qr/(?(DEFINE)(?<NUMERO>[\d,]+(?:[.]\d+)?))/x;
 
## Argumentos
# Ruta a la carpeta a procesar
my $path;
GetOptions(
    'path=s'    => \$path,
);
$path           or die "Uso: $0 -path=<carpeta con registros a procesar>\n";
-d $path        or die "ERROR: la carpeta no existe: $!\n";
chdir $path     or die "ERROR: no puedo entrar en [$path]: $!\n";
 
## Procesamiento
# Lista de archivos identificados como informes
my @archivos;
opendir (my $DIR , ".");
while (my $archivo = readdir $DIR) {
    next if $archivo !~ $PLANTILLA_INFORMES;
    push @archivos, $archivo;
}
closedir $DIR;
 
# Si hay archivos que procesar, los procesamos
if (@archivos) {
    open my $OUT, '>', $ARCHIVO_SALIDA;
    printf  $OUT $FORMATO_SALIDA, @CABECERAS;
 
    my @salida;
 
    for my $archivo (@archivos) {
 
        # Leer archivo
        my $informe;
        if (open my $IN, '<', $archivo) {
            local $/;           # modo aspiradora
            $informe = <$IN>;
            close $IN;
        }
 
        # Sample
        push @salida, $archivo =~ $PLANTILLA_INFORMES;
 
        # Loading reads
        # -------------
        if ($informe =~ m{
                ^ Loading [ ] reads .+? \n
                -+ \n
                (?<INPUTREAD>(?&NUMERO)) [ ] / [ ] (?&NUMERO) [ ] \( (?&NUMERO) % \) [ ] - [ ] (?<INPUTBP>(?&NUMERO)) [ ] bp
                $DEFINES
            }msx
        ) {
            push @salida, convierte($+{INPUTREAD}), convierte($+{INPUTBP});
        }
 
        # Assembling contigs
        if ($informe =~ m{
                ^ Assembling [ ] contigs .+? \n
                -+ \n
                (.+?) \n{3}
            }msx
        ) {
            my $assembly = $1;
 
            my($lin_unitig) = $assembly =~ /^\s*(\d+) linear unitig/m;
            my($cir_unitig) = $assembly =~ /^\s*(\d+) circular unitig/m;
            my($total_bp)   = $assembly =~ /total size = (?<TOTALBP>(?&NUMERO)) bp$DEFINES/m;
            $lin_unitig ||= 0;
            $cir_unitig ||= 0;
            $total_bp     = convierte($total_bp);
 
            push @salida, $cir_unitig, $lin_unitig, $total_bp;
        }
 
        # Polishing miniasm assembly with Racon
        if ($informe =~ m{
                ^ Polishing [ ] miniasm [ ] assembly .+? \n
                -+ \n
                (.+?) \n{3}
            }msx
        ) {
            my $polish = $1;
            # Extraer la tabla de datos
            my @tabla;
            for (split /\n/, $polish) {
                if (/^Polish/ .. /^$/) {
                    push @tabla, $_;
                }
            }
            # Buscar el máximo
            my($max_assembly, $max_qa) = (0, 0);
            if (@tabla) {
                # las dos últimas filas
                for (@tabla[-2, -1]) {
                    # partimos la línea en tres partes
                    if (my(undef, $assembly, $qa) = split " ") {
                        $assembly = convierte($assembly);
                        $qa       = convierte($qa);
                        # nos quedamos con el mayor valor de quality
                        if ($max_qa < $qa) {
                            $max_qa = $qa;
                            $max_assembly = $assembly;
                        }
                    }
                }
            }
            push @salida, $max_qa, $max_assembly;
        }
        
        printf $OUT $FORMATO_SALIDA, @salida;
 
        # Rotating completed replicons
        if ($informe =~ m{
                ^ Rotating [ ] completed [ ] replicons .+?
                ( ^ Segment .+? )
                \n{2}
            }msx
        ) {
            print $OUT "$1\n";
        }
 
    } # next $archivo
 
    close   $OUT;
}
 
# Convierte de notación inglesa a española
sub convierte {
    my $numero = shift;
    $numero =~ s/,//g;
    $numero += 0;
    return $numero;
}
 
__END__
Coloreado en 0.004 segundos,  usando GeSHi 1.0.8.4

Esta es la salida:

Sintáxis: [ Descargar ] [ Ocultar ]

Using text Syntax Highlighting

Sample  Input_Reads     Input_bp        Circular_contigs        Linear_contigs  Total_size_bp_before_polish     max_score_after_polish  final_size_after_polish

inicio  38855           254724562       1                       0               1671271                         33682.91                1685628                

Segment   Length      Depth   Starting gene   Position   Strand   Identity   Coverage

      1   1,685,628   1.00x   none found                                             

      2     585,617   1.00x   none found   Coloreado en 0.000 segundos,  usando GeSHi 1.0.8.4

por **Alfumao** » 2023-08-04 06:10 @298

Hola de nuevo, explorer.

He modificado tu script para que cumpla con las necesidades reales, que son:

Poder procesar cientos de logs presentes en un mismo directorio para sacar una tabla que les incluya a todos, que esté separada por tabuladores y sea fácilmente exportable a Excel, si fuera el caso (eliminé el formato que le diste a las cabeceras e incluí un reinicio del array de datos para que pudieran caber logs secuencialmente).

Ejemplo del formato:

Sintáxis: (Unicycler_logs_parsed_3.tsv) [ Descargar ] [ Ocultar ]
Sintáxis: (Unicycler_logs_parsed_3.tsv) [ Descargar ] [ Mostrar ]
Using text Syntax Highlighting

Sample Input_Reads Input_bp Circular_contigs Linear_contigs Total_size_bp_before_polish max_score_after_polish final_size_after_polish
HUBC50765343 14736 87790955 1 0 1708070 11851.41 1728821
HUBC51089086 12307 43200839 0 12 1189336 6080.87 1202453
HUBC51130095 14780 30530573 0 9 115115 1009.79 117534
HUBC52251288 30933 70953558 0 41 1635213 16833.84 1655600
Coloreado en 0.000 segundos, usando GeSHi 1.0.8.4
Obtener, por un lado una tabla con los parámetros de interés y por otro un archivo donde encontremos la tabla de contigs de todos esos logs, precedida por el nombre del log que se procesa (añadí la impresión del nombre del archivo precediendo a la tabla y las saqué a una salida diferente a la de los otros datos).

Ejemplo del formato:

Sintáxis: (Unicycler_tables_3.tsv) [ Descargar ] [ Ocultar ]
Sintáxis: (Unicycler_tables_3.tsv) [ Descargar ] [ Mostrar ]
Using text Syntax Highlighting

HUBC50765343_LRassembly.unicycler.log
Segment Length Depth Starting gene Position Strand Identity Coverage
1 1,728,821 1.00x none found
HUBC56801624_LRassembly.unicycler.log
Segment Length Depth Starting gene Position Strand Identity Coverage
1 1,622,619 1.00x none found
HUDC61355553_LRassembly.unicycler.log
Segment Length Depth Starting gene Position Strand Identity Coverage
1 1,679,694 1.00x none found
2 47,978 0.94x none found
Coloreado en 0.000 segundos, usando GeSHi 1.0.8.4

Y aquí te dejo el script final.

Sintáxis: (UnicExplorer_JL.pl) [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

#!/usr/bin/perl
#
# Procesar registro generado por Unicycler
#
# Joaquín Ferrero, julio 2023 (adaptado por JLL, agosto 2023)
#
# tercera versión: 20230806
#
# usage example:
#
#    perl UnicExplorer_JL.pl -p /path_to_files
#
 
use v5.24;              # mínima versión de Perl
use strict;             # programación estricta
use warnings;           # activar advertencias
 
use Getopt::Long;
use autodie;            # para toda la E/S
 
 
## Constantes #####################################################
my $PLANTILLA_INFORMES  = qr/(\w+)\_LRassembly[.]unicycler[.]log/;
my $ARCHIVO_SALIDA      = 'Unicycler_logs_parsed_3.tsv';
my $ARCHIVO_SALIDA2     = 'Unicycler_tables_3.tsv';
my @CABECERAS           = qw(
     Sample Input_Reads Input_bp Circular_contigs Linear_contigs
     Total_size_bp_before_polish max_score_after_polish final_size_after_polish
);
my $DEFINES             = qr/(?(DEFINE)(?<NUMERO>[\d,]+(?:[.]\d+)?))/x;
 
## Argumentos #####################################################
# Ruta a la carpeta a procesar
my $path;
GetOptions(
    'path=s'    => \$path,
);
$path           or die "Uso: $0 -path=<carpeta con registros a procesar>\n";
-d $path        or die "ERROR: la carpeta no existe: $!\n";
chdir $path     or die "ERROR: no puedo entrar en [$path]: $!\n";
 
## Procesamiento ##################################################
# Lista de archivos identificados como informes
my @archivos;
opendir (my $DIR , ".");
while (my $archivo = readdir $DIR) {
    next if $archivo !~ $PLANTILLA_INFORMES;
    push @archivos, $archivo;
}
closedir $DIR;
 
# Si hay archivos que procesar, los procesamos
if (@archivos) {
    open my $OUT, '>', $ARCHIVO_SALIDA;
    print $OUT join("\t", @CABECERAS), "\n";
 
    open my $OUT2, '>', $ARCHIVO_SALIDA2;
 
    for my $archivo (@archivos) {
        my @salida;
        # Leer archivo
        my $informe;
        if (open my $IN, '<', $archivo) {
            local $/;           # modo aspiradora
            $informe = <$IN>;
            close $IN;
        }
        # Sample
        push @salida, $archivo =~ $PLANTILLA_INFORMES;
 
        # Loading reads
        # -------------
        if ($informe =~ m{
                ^ Loading [ ] reads .+? \n
                -+ \n
                (?<INPUTREAD>(?&NUMERO)) [ ] / [ ] (?&NUMERO) [ ] \( (?&NUMERO) % \) [ ] - [ ] (?<INPUTBP>(?&NUMERO)) [ ] bp
                $DEFINES
            }msx
        ) {
            push @salida, convierte($+{INPUTREAD}), convierte($+{INPUTBP});
        }
 
        # Assembling contigs
        # ------------------
        if ($informe =~ m{
                ^ Assembling [ ] contigs .+? \n
                -+ \n
                (.+?) \n{3}
            }msx
        ) {
            my $assembly = $1;
 
            my($lin_unitig) = $assembly =~ /^\s*(\d+) linear unitig/m;
            my($cir_unitig) = $assembly =~ /^\s*(\d+) circular unitig/m;
            my($total_bp)   = $assembly =~ /total size = (?<TOTALBP>(?&NUMERO)) bp$DEFINES/m;
            $lin_unitig   ||= 0;
            $cir_unitig   ||= 0;
            $total_bp       = convierte($total_bp);
 
            push @salida, $cir_unitig, $lin_unitig, $total_bp;
        }
 
        # Polishing miniasm assembly with Racon
        # -------------------------------------
        if ($informe =~ m{
                ^ Polishing [ ] miniasm [ ] assembly .+? \n
                -+ \n
                (.+?) \n{3}
            }msx
        ) {
            my $polish = $1;
 
            # Extraer la tabla de datos
            my @tabla;
            for (split /\n/, $polish) {
                if (/^Polish/ .. /^$/) {
                    push @tabla, $_;
                }
            }
 
            # Buscar el máximo
            my($max_assembly, $max_qa) = (0, 0);
            if (@tabla) {
                # las dos últimas filas
                for (@tabla[-2, -1]) {
                    # partimos la línea en tres partes
                    if (my(undef, $assembly, $qa) = split " ") {
                        $assembly = convierte($assembly);
                        $qa       = convierte($qa);
                        # nos quedamos con el mayor valor de quality
                        if ($max_qa < $qa) {
                            $max_qa = $qa;
                            $max_assembly = $assembly;
                        }
                    }
                }
            }
            push @salida, $max_qa, $max_assembly;
        }
        print $OUT join("\t", @salida), "\n";      # print tab separated array in OUTFILE
 
        # Rotating completed replicons
        # ----------------------------
        if ($informe =~ m{
                ^ Rotating [ ] completed [ ] replicons .+?
                ( ^ Segment .+? )
                \n{2}
            }msx
        ) {
            print $OUT2 "$archivo\n$1\n";
        }
 
    } # next $archivo
 
    close   $OUT;
    close   $OUT2;
}
 
# Convierte de notación inglesa a española
sub convierte {
    my $numero = shift;
    $numero =~ s/,//g;
    $numero += 0;
    return $numero;
}
 
__END__
Coloreado en 0.005 segundos,  usando GeSHi 1.0.8.4

Muchísimas gracias una vez más por tu ayuda, ¡eres un super crack!

por **explorer** » 2023-08-06 01:34 @107

Le he hecho un par de cambios:

* añadir un close $OUT2;

* cambiar de posición my @salida;, dentro del for(), para que así no tengas que resetearlo en cada vuelta.

* formateo del código.

Foro - Perl en Español

Capturar doble salto línea con expresión regular

Capturar doble salto línea con expresión regular

Publicidad

Re: Capturar doble salto línea con expresión regular

Re: Capturar doble salto línea con expresión regular

Re: Capturar doble salto línea con expresión regular

Re: Capturar doble salto línea con expresión regular

Re: Capturar doble salto línea con expresión regular

Re: Capturar doble salto línea con expresión regular

Re: Capturar doble salto línea con expresión regular

Re: Capturar doble salto línea con expresión regular

Re: Capturar doble salto línea con expresión regular

¿Quién está conectado?