Ho un file con un mucchio di righe e voglio confrontare per vedere se tutti i caratteri di una particolare colonna corrispondono con il resto del file in Perl. Ad esempio se ho un file:
abcdefg
avcddeg
acbdeeg
Il file verrebbe letto a, d, g come partite e restituire la posizione.
Stavo pensando di utilizzare un array 2D in perl per attraversare e confrontare l'intero file, ma può diventare noioso. Qualcuno ha un modo più semplice per farlo?
Grazie
risposte:
7 per risposta № 1Ecco una soluzione intelligente (e veloce) che utilizza operazioni bit per bit. Si basa sul fatto che a & b & ... & z
equivale a | b | ... | z
se e solo se tutto a
, b
, ..., z
sono uguali.
# 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;
}
Test di input:
abcdefg
avcddeg
acbdeeg
Produzione:
0: a
3: d
6: g
Ps. Questa soluzione funziona anche se le linee hanno lunghezze diverse; nessuna colonna oltre la fine della riga più corta sarà considerata corrispondente.
1 per risposta № 2
Poiché è necessario confrontare ogni indice con gli altri per determinare una corrispondenza completa, non sono sicuro di come renderlo meno noioso. È possibile evitare di creare array 2D utilizzando sottostringhe.
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 per risposta № 3
Puoi usare xor bit per bit ^
. Lo xoraggio di due stringhe lascia degli zeri nelle posizioni in cui le stringhe sono identiche.
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 per risposta № 4
Non efficace e affamato di memoria, ma abbastanza leggibile e semplice:
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 per risposta № 5
Puoi anche leggere il file riga per riga, contrassegnando gli elementi dell'array come undef
quando c'è una riga per la quale non esiste una corrispondenza comune:
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[$_]);
}
Per l'input nella tua domanda, l'output è:
Here are the common characters and positions:
1: a
4: d
7: g
Nota che questo codice presume che tutti i tuoi filele righe sono della stessa lunghezza (o, per lo meno, nessuna riga è più lunga della prima riga). Se non è così, dovrai modificare il codice di conseguenza.