Foro - Perl en Español

por **Alfumao** » 2016-03-14 06:56 @330

Hola a todos.

Tengo un problemilla que no sé muy bien cómo enfocar en el título de este mensaje.

La historia es que tengo una tabla cuyos campos tienen un identificador que modifiqué en su día, y cuyo nombre original guardé en un txt junto a su nuevo nombre en formato:

Sintáxis: [ Descargar ] [ Ocultar ]

Using text Syntax Highlighting

Nombre_nuevo1 Nombre_antiguo1

Nombre_nuevo2 Nombre_antiguo2

Nombre_nuevo3 Nombre_antiguo3

Nombre_nuevo4 Nombre_antiguo4Coloreado en 0.000 segundos,  usando GeSHi 1.0.8.4

Y así varios miles de registros.

Tras trabajar con estos nombres, tengo una tabla final en la que aparecen solo entradas correspondientes a los nombres nuevos:

Sintáxis: [ Descargar ] [ Ocultar ]

Using text Syntax Highlighting

Nombre_nuevo1 Nombre_nuevo43 Nombre_nuevo17 Nombre_nuevo1245 ...

Nombre_nuevo2 Nombre_nuevo4 Nombre_nuevo37 Nombre_nuevo125 ...

Nombre_nuevo3 Nombre_nuevo51 Nombre_nuevo69 Nombre_nuevo342 ...Coloreado en 0.000 segundos,  usando GeSHi 1.0.8.4

Así pues, he de reemplazar en el mismo archivo (tabla) todos los nombres nuevos por sus correspondientes antiguos (están todos incluidos en el txt que mencioné al principio).

Como no se me ocurría otra forma de hacerlo decidí ejecutar un oneliner para que reemplazase cada Nombre_nuevo por el Nombre_antiguo (no se me ocurre cómo editar el archivo y luego escribirlo una vez hechos todos los reemplazos).

Aquí os dejo el código por sí podéis ayudarme.

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

#!/usr/bin/perl -w
use strict;
use Getopt::Long;
 
#usage example: perl /storage/Runs/CIC/ANALYSIS/JL_scripts/GetbackIDs.pl -p /storage/... -e txt
#requiere un archivo de secuencias y una "base de datos de IDs" en formato ".txt" que se llamen igual 
my ($path, $ext);
GetOptions(
    'path=s'      => \$path,
    'extension=s' => \$ext,
    );
    
print "$path\n";
chdir $path or die "ERROR: Unable to enter $path: $!\n";
opendir (TEMP , ".");
my @files = readdir (TEMP);
closedir TEMP;
print "@files\n";
 
my $name;
my @db;
for my $file (@files) {
    if($file=~/(\w+).$ext/){
        $name = "$1";
        print"This is the Filename: $file\n";
        open (INFILE, "$file") || die ("cannot open input file");
        chomp(my @data = <INFILE>);
        my$file2= "$name.bd";
        print"This is the DBname:$file2\n";
        open (DB, "$file2") || die ("cannot open input file");
        chomp(@db = <DB>);    
    }    
#Reemplazo "on the fly" via One-Liner
for(@db){
        my ($dbid,$firstid) = split(/\t/, $_);
        chomp $firstid;
        print"This is my $dbid and its $firstid\n";
        ##ONELINER #si matchea la id, hacemos cambio
        my$susti=`perl -pi -e 's/$dbid/$firstid/g' $name.$ext`;
        }
    }
Coloreado en 0.003 segundos,  usando GeSHi 1.0.8.4

El problema es que parece que se hacen múltiples renombrados uno sobre otro y terminan duplicándose los nombres de varias entradas... Vamos, que el oneliner no funciona correctamente dentro del bucle for (o ese creo yo que debe ser el fallo).

Un saludo.

Aspergillus_clavatus_1  XP_001276684.1 pectate lyase, putative [Aspergillus clavatus NRRL 1]
Aspergillus_fumigatus_2 XP_001276694.1 conserved hypothetical protein [Aspergillus fumigatus NRRL 1]
Aspergillus_flavus_3    XP_001276726.1 tyrosinase central domain protein [Aspergillus flavus NRRL 1]
Aspergillus_terreus_4   XP_001276738.1 endoglucanase, putative [Aspergillus terreus NRRL 1]
Coloreado en 0.000 segundos,  usando GeSHi 1.0.8.4

Líneas de la tabla a renombrar:

Sintáxis: [ Descargar ] [ Ocultar ]

Using text Syntax Highlighting

Aspergillus_clavatus_1  Aspergillus_flavus_198  Aspergillus_terreus_166 Aspergillus_fumigatus_2 
Aspergillus_clavatus_1  Aspergillus_flavus_3    Aspergillus_terreus_4   Aspergillus_fumigatus_2
Aspergillus_clavatus_3  Aspergillus_flavus_198  Aspergillus_terreu_166  Aspergillus_fumigatus_16
Coloreado en 0.000 segundos,  usando GeSHi 1.0.8.4

Resultado esperado (si el ID a reemplazar no está en la base de datos, no se reemplazaría)

Sintáxis: [ Descargar ] [ Ocultar ]

Using text Syntax Highlighting

XP_001276684.1 pectate lyase, putative [Aspergillus clavatus NRRL 1]    Aspergillus_flavus_198  Aspergillus_terreus_166 XP_001276694.1 conserved hypothetical protein [Aspergillus fumigatus NRRL 1]    
XP_001276684.1 pectate lyase, putative [Aspergillus clavatus NRRL 1]    XP_001276726.1 tyrosinase central domain protein [Aspergillus flavus NRRL 1]    XP_001276738.1 endoglucanase, putative [Aspergillus terreus NRRL 1]     XP_001276694.1 conserved hypothetical protein [Aspergillus fumigatus NRRL 1]
Aspergillus_clavatus_3  Aspergillus_flavus_198  Aspergillus_terreu_166  Aspergillus_fumigatus_16
Coloreado en 0.000 segundos,  usando GeSHi 1.0.8.4

por **explorer** » 2016-03-14 17:21 @764

Esta es una posible solución:

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

#!/usr/bin/env perl
use v5.14;
use autodie;
 
## Leer la base de datos
my @cambios;
open my $BASE, '<', 'base_datos.txt';
while (<$BASE>) {
    chomp;
    my($anterior, $nuevo) = split " ", $_, 2;           # partimos la línea en dos cachos
    push @cambios, [ $anterior, $nuevo ];               # y los guardamos en un array de arrays
}
close $BASE;
 
#use Data::Dumper;
#say Dumper \@cambios;
 
## Procesar los archivos
for my $archivo ('tabla.txt') {                         # por cada archivo
    open my $ARCHIVO, '<',  $archivo;                   # lo abrimos en lectura
    open my $NUEVO,   '>', "$archivo.new";              # abrimos el resultado, en escritura
 
    while (my $linea = <$ARCHIVO>) {                    # por cada línea
        chomp $linea;
        
        for my $cambio_ref (@cambios) {                 # por cada cambio que deseamos hacer
            my($anterior, $nuevo) = @$cambio_ref;
 
            $linea =~ s/\b$anterior\b/$nuevo/g;         # lo hacemos. Atención a los '\b'
        }
 
        say $NUEVO $linea;                              # guardamos el resultado
    }
 
    close $ARCHIVO;
    close $NUEVO;
}
Coloreado en 0.002 segundos,  usando GeSHi 1.0.8.4

Es demasiado sencilla: recorremos todos los cambios por cada línea por cada archivo, lo cual puede eternizarse en caso de que sean muchos archivos o muchas líneas o muchos cambios.

Una forma de optimizarlo es crear una expr. reg. con todas las opciones que buscamos, y mediante un hash, hacer el cambio:

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

#!/usr/bin/env perl
use v5.14;
use autodie;
 
## Leer la base de datos
my %cambios;
open my $BASE, '<', 'base_datos.txt';
while (<$BASE>) {
    chomp;
    my($anterior, $nuevo) = split " ", $_, 2;           # partimos la línea en dos cachos
    $cambios{ $anterior } = $nuevo;                     # y los guardamos en un hash
}
close $BASE;
 
## Creación de la exp. reg.
my $regex = join '|' => keys %cambios;
$regex = qr/\b($regex)\b/;
 
#use Data::Dumper;
#say Dumper \%cambios; 
 
## Procesar los archivos
for my $archivo ('tabla.txt') {                         # por cada archivo
    open my $ARCHIVO, '<',  $archivo;                   # lo abrimos en lectura
    open my $NUEVO,   '>', "$archivo.new";              # abrimos el resultado, en escritura
 
    while (my $linea = <$ARCHIVO>) {                    # por cada línea
 
        $linea =~ s/$regex/$cambios{$1}/g;              # cambiamos lo que encontramos
 
        print $NUEVO $linea;                            # guardamos el resultado
    }
 
    close $ARCHIVO;
    close $NUEVO;
}
Coloreado en 0.001 segundos,  usando GeSHi 1.0.8.4

por **Alfumao** » 2016-03-15 09:01 @418

¡Gracias, explorer!

Funciona perfectamente.

Muy interesante el uso de \b en la expresión regular para marcar los límites y evitar solapes en la localización.

por **explorer** » 2016-03-16 03:48 @200

Pues sí, porque no es lo mismo buscar por

Aspergillus_clavatus_1

que por

Aspergillus_clavatus_11

o

Aspergillus_clavatus_121

Si no fuera por las anclas \b, una clave en %cambios podría solapar sus cambios donde coincidiese primero. Con las anclas, obligamos a buscar conjuntos (palabras) completos. Pero funciona en este problema en particular porque los archivos se componen de elementos separados por espacios o los límites de línea. En otros casos habrá que buscar otro método.

Foro - Perl en Español

Renombrar campos de tabla a partir de una Base de Datos txt

Renombrar campos de tabla a partir de una Base de Datos txt

Publicidad

Re: Renombrar campos de tabla a partir de una Base de Datos

Re: Renombrar campos de tabla a partir de una Base de Datos

Re: Renombrar campos de tabla a partir de una Base de Datos

Re: Renombrar campos de tabla a partir de una Base de Datos

¿Quién está conectado?