Manera simple de comparar un personaje en una posición en una línea con el resto de líneas en la misma posición (Perl) - perl, comparación, posición, personaje

Tengo un archivo con un montón de líneas y quiero comparar para ver si todos los caracteres de una columna en particular coinciden con el resto del archivo en Perl. Por ejemplo, si tengo un archivo:

abcdefg
avcddeg
acbdeeg

El archivo leería a, d, g como fósforos y devolver la posición.

Estaba pensando en usar una matriz 2D en Perl para recorrer y comparar todo el archivo, pero puede resultar tedioso. ¿Alguien tiene una manera más fácil de hacer esto?

Gracias

Respuestas

7 para la respuesta № 1

Esta es una solución inteligente (y rápida) que utiliza operaciones bit a bit. Se basa en el hecho de que a & b & ... & z es igual a a | b | ... | z si y solo si todos a, b, ..., z son iguales.

# read first line:
chomp( $_ = <> );
my $join = my $meet = $_;

# read other lines:
while( <> ) {
chomp;
$join |= $_;
$meet &= $_;
}

# print matching columns:
foreach my $i ( 0 .. length($meet) - 1 ) {
my $a = substr $join, $i, 1;
my $b = substr $meet, $i, 1;
print "$i: $an" if $a eq $b;
}

Entrada de prueba:

abcdefg
avcddeg
acbdeeg

Salida:

0: a
3: d
6: g

PD. Esta solución funciona incluso si las líneas tienen diferentes longitudes; ninguna columna más allá del final de la línea más corta se considerará coincidente.

---

1 para la respuesta № 2

Dado que necesita comparar cada índice con los demás para determinar una coincidencia completa, no estoy seguro de cómo puede hacerlo menos tedioso. Puede evitar la creación de matrices 2D utilizando subcadenas.

my @matchedIndexes;
my $pattern = "abcdefg";
INDEX:
for $index ( 0 .. ( length($pattern) - 1 ) ){
for $line (@remainingLines){
#if we find a nonmatch at the index, cut out.
if ( !(substr($line, $index, 1) == substr($pattern, $index, 1) ){
next INDEX;
}
}
#if we made it here without cutting out, the whole set of lines matched.
push @matchedIndexes, $index;
}

---

1 para la respuesta № 3

Puede usar xor bit a bit ^. Xoring dos cadenas deja ceros en posiciones donde las cadenas son idénticas.

use warnings;
use strict;

my $previous;
my $first = 1;
while (<>) {
chomp;
$previous = $_ if $first;
undef $first;
my $in = $previous ^ $_;
my $p;
my @u = unpack "c*", $in;
$p .= $u[$_] ? " " : substr $previous, $_, 1 for 0 .. $#u;
$previous = $p;
last if $p =~ /^ +$/; # no more matches possible
}

print pos $previous, ": $1n" while $_ = $previous =~ /(S)/g;

---

1 para la respuesta № 4

No es efectivo y tiene mucha memoria, pero es bastante legible y sencillo:

use strict;use warnings;

my $lead = <DATA>;
chomp $lead;
my $rest = do { local $/; <DATA> };

for (my $i = 0; $i < length $lead; $i++ ) {
my $char = substr $lead, $i, 1;
next if $rest =~ /^.{$i}[^Q$charE]/m;
print "$i:$charn";
}


__DATA__
abcdefg
avcddeg
acbdeeg

---

0 para la respuesta № 5

También puede leer el archivo línea por línea, marcando los elementos de la matriz como undef cuando hay una línea para la que no hay una coincidencia común:

use strict;
use warnings;

open(my $read,"<","input_file") or die $!;

my $first=1; #Flag to indicate whether or not we are on the first line.
my @characters=(); #Array for characters

while(my $line=<$read>)
{
chomp($line);
if($first)
{
@characters=split(//,$line);
$first=0;
}
else
{
my @temp_arr=split(//,$line);

foreach(0..$#characters)
{
$characters[$_]=undef unless $characters[$_] eq $temp_arr[$_];
}
}

#If we do not have any characters in common, bail out!
unless(scalar(grep{defined($_)}@characters))
{
print "Sorry, there are no characters in common positions within all rows of file input_filen";
exit(1);
}
}

close($read);

print "Here are the common characters and positions:nn";

foreach(0..$#characters)
{
print "" . ($_ + 1) . ": " . $characters[$_] . "n" if defined($characters[$_]);
}

Para la entrada en su pregunta, la salida es:

Here are the common characters and positions:

1: a
4: d
7: g

Tenga en cuenta que este código asume que todos suslas líneas tienen la misma longitud (o, al menos, ninguna línea es más larga que la primera). Si ese no es el caso, deberá ajustar el código en consecuencia.

---