Newsgroup: it.comp.lang.perl
Titolo: Help sostituzione carattere

Salve,
ho due array uguali per numero di stringhe e numero di caratteri delle 
stringhe:
L'array A è:
MRVTAPRTLLLLLWGALALTETWAGSHSMRYFYTAMSRPGRGEPRFISVGYVDDTQFVRF
DSDAASPREEPRAPWIEQEGPEYWDRNTQIYKAQAQTDRESLRNLRGYYNQSEAGSHTLQ
RMFGCDLGPDGRLLRGHNQLAYDGKDYIALNEDLSSWTAADTAAQITQRKWEAARVAEQD
RAYLEGLCVESLRRYLENGKETLQRADPPKTHVTHHPISDHEATLRCWALGFYPAEITLT
WQRDGEDQTQDTELVETRPAGDRTFQKWAAVVVPSGEEQRYTCHVQHEGLPKPLTLRWEP
SSQSTIPIVGIVAGLAVLAVVVIGAVVATVMCRRKSSGGKGGSYSQAASSDSAQGSDVSL
TA---
il B è:
---MGPGTLFMLLLGALVLIETRAGSHSLRYFHTAVSRPGLREPLFITVGYVDDTQFVRF
DSDARDPRTEPRQPWMEKEGPEYWDRETQISKENALWYREALNNLRGYYNQSEAGSHTLQ
EMYGCDVGSDGRLRRGYEQYGYDGRDYLALNEDLRSWTAADTAAQISKRKMEAAGAAERF
RNYLEGTCVEWLRRYLENGKDTLLRADPPKAHVTRHPSSEHEVTLRCWALGFYPEEISLT
WQRNGEDQTQDMELVETRPSGDGNFQKWAALVVPSGEEQRYTCRVQHEGLQEPLTLRWEP
P-QTSFLTMGIIVGLVLLVVAVV---AGAVIWMKKHSGEKRRTYTQAASNDSAQGSDVSL
TVPKV
Come facco per togliere i trattini ( - ) da A e B e togliere le 
corrispondenti lettere dei trattini nell'altro array ?
Esempio: togliere i 3 trattini da TA e le corrispondenti lettere PKV 
nell'ultima stringa di B ? E lo stesso nella prima riga in B e la 
corrispondente di A (MRV) ?
Per favore aiutatemi ? Sono disperato perchè non ci riesco ?
Giuseppe

 
Uh? C'č qualche punto di domanda di troppo, mi sa.
Max

 stringhe:
va a farsi friggere per la formattazione che ha preso il testo del post.
Scrivilo in perl, così non ci saranno dubbi, ok?
ciao
--
-.. --- -- .. --.. .. ---
-.. . -- .. -.-. .... . .-.. .. ...

Non hai ancora risposto, ma nel frattempo ti ho scritto qualcosa secondo le
supposizioni precedenti:
====== CODE ========
# Array @A composto da 5 caratteri per 3 righe
@A = qw (
D--KD
GSJDK
G-DAO
);
# Array @B composto da 5 caratteri per 3 righe
@B = qw (
DEQRF
PSOR-
-TIDV
);
sub sync_dashes
# riceve reference ai due array da sincronizzare
# e sincronizza gli array originali
{
 my ($A, $B) = @_;
 # per ogni riga di @A (che ha le stesse righe di @B)
 for my $ai (0..$#$A)
 {
   # trasformiamo la stringa in un array di caratteri
   my @sA = split //, $A->[$ai];
   my @sB = split //, $B->[$ai];
   # per ogni array di caratteri
   for my $di (0..$#sA)
   {
    # mettiamo il '-' in @sA e in @sB
    $sA[$di] = $sB[$di] = '-'
       # se č un treattino in @sA o in @sB
       if $sA[$di] eq '-' || $sB[$di] eq '-';
  }
  # ricomponiamo la stringa
  $A->[$ai] = join '', @sA;
  $B->[$ai] = join '', @sB;
 }
}
sync_dashes \@A, \@B;
# Adesso @A e @B avranno i '-' sincronizzati
# nota: split e join sono piů rapidi di substr
========= END CODE ==========
Fammi sapere se ho capito le tue intenzioni


 
---- CUT -----
Grazie per le risposte, sì hai capito le mie intenzioni (anche se non ho 
scritto in Perl !)
Nel frattempo che mi rispondevate (grazie ancora a Max e a te) ho risolto in 
una maniera da principiante che sono:
foreach $indice(0..$#A)         { 
while ($A[$indice]=~/-/g)       {
$position = pos ($A[$indice]);
substr($B[$indice],$position-1,1) = " ";                         #Inserisco 
uno spazio
substr($A[$indice],$position-1,1) = " ";
                                }
while ($B[$indice]=~/-/g)       {
$position = pos ($B[$indice]);
substr($A[$indice],$position-1,1) = " ";                        
substr($B[$indice],$position-1,1) = " ";
                        }
$A[$indice] =~s/ +//g;                          #Li rimuovo
$B[$indice] =~s/ +//g;
                                }
Ciao
Giuseppe

 Max

Acc ! Sbadato che sono ! Lo spazio potevo evitare di metterlo,
bastava fare substr($A[$indice],$position-1,1) = "";
così tolgo anche $A[$indice] =~s/ +//g;
Non ci fate caso...
Giuseppe



Come hai fatto il confronto? Io ho riscritto la tua sync_dashes()
utilizzando substr() nella parte in cui tu fai split e join e ho ottenuto
qualcosa di significativamente (si fa per dire)  più veloce: su vari input
ottengo sempre un tempo pari a 0.7/0.8 volte quello della funzione
originale.
 sub sync_dashes2
 # riceve reference ai due array da sincronizzare
 # e sincronizza gli array originali
 {
  my ($A, $B) = @_;
  # per ogni riga di @A (che ha le stesse righe di @B)
  for my $ai (0..$#$A)
  {
   my $sAr = \$A->[$ai]; 
   my $sBr = \$B->[$ai];
   my $sz = length $$sAr;	
   for( my $i = 0; $i < $sz; ++$i )
   {
	$cAr = \substr( $$sAr, $i, 1 );
	$cBr = \substr( $$sBr, $i, 1 );
	if ( $$cAr eq '-' ||  $$cBr eq '-' )
	{
		$$cAr = '-'; $$cBr = '-'; 
	}
   }
  }
 } 
MM

Ahhhh... ma allora vedi che non ho capito un cazzo di quello che ti serviva
fare?
Il mio code ti modifica i 2 array in modo da mettere trattini al posto di
eliminare il caratere:
Es:
AB-DEF confrontato con G-ILMN ritorna A--DEF e G--LMN
e invece tu vuoi che ritorni ADEF e GLMN ?
allora dovresti cambiare:
    $sA[$di] = $sB[$di] = '-'
con
    $sA[$di] = $sB[$di] = undef
e fa come vuoi tu.
Il tuo codice non è per niente male... anzi, è MOLTO meglio del mio! Ho
fatto un benchmark e gira in poco più della metà di quanto gira il mio :-(.
Alla faccia che il tuo è da principiante! Ma scusa: perché chiedi a noi se
da solo sai fare le cose meglio di come ti suggeriamo? :-)
Per curiosità:  qual'è l'applicazione pratica di simile operazione?
Ciao


 wrote in message
news:Pine.LNX.4.21.021004...@localhost.localdomain...


 substr($B[$indice],$position-1,1) = " ";     #Inserisco 
Sarai pure principiante, ma il problema l'hai risolto più o meno come ho
fatto io, salvo che io ho usato index() al posto di /-/g e non avevo
capito che si trattava di array di stringhe (pensavo fossero due grosse
stringone su più righe).
Max

 così tolgo anche $A[$indice] =~s/ +//g;
Questo comunque non direi proprio che si possa fare... perché se elimini un
carattere dall'altra stringa in B, poi la pos non sarà più uguale, perché la
lunghezza di B sarà differente dalla lunghezza di A.
Questo errore (in cui inizialmente sono caduto anch'io)  è quello che
permette dei benchmark così rapidi!!!
In realtà come dice Max, c'è solo una differenza di 0.7 - 0.8 fra usare il
mio split, foreach e join con l'usare while substr.
Comunque mi sono permesso di ottimizzare un po' il tuo code (eliminando un
paio di linee che non servivano), sostituendo un paio di s/// con tr/// e di
scriverlo un po' più leggibile:
===== CODE =======
 foreach $i (0..$#A)
 {
     while ( $A[$i] =~ /-/g )
     {
      my $pos = pos $A[$i];
      substr ( $B[$i], $pos -1, 1 ) = '-'
     }
     while ($B[$i] =~ /-/g)
     {
      my $pos = pos $B[$i];
      substr ( $A[$i], $pos -1, 1 ) = '-'
     }
     $A[$i] =~ tr/-//d;
     $B[$i] =~ tr/-//d;
 }
======= END CODE =======
Nota che tr/-//d è più rapido di s/ +//g. E questo sono SICURO di averlo
letto e provato :-) )
ciao


 Per favore aiutatemi ? Sono disperato perchè non ci riesco ?
Vediamo se ho capito:
$a='1234---56--------78-9';
$b='1234xxx56********78x9';
while ($a=~s/^([^-]*)\-/$1/) {
        $len=length($1);
        $b=~s/^(.{$len})./$1/;
}
print "$a\n$b\n";
-- 
Saluti,
Giancarlo

> Vediamo se ho capito:
mi sembra proprio di no :-)


 wrote in message
news:ankhch$eutnj$1...@ID-159100.news.dfncis.de...


  }
Questo è ancora più veloce. Ma è più brutto. :-)
 my $a, $b, $p;
 foreach $i( 0..$#A )
 {
  $a = \$A[$i]; $b = \$B[$i];
  $p = 0;		
  while( -1 != ( $p = index $$a, '-', $p ) ) 
      { substr( $$b, $p++, 1 ) = "\0";  }
  $p = 0;		
  while( -1 != ( $p = index $$b, '-', $p ) ) 
      { substr( $$a, $p++, 1 ) = "\0";  }
  $$a =~ tr/-\0//d;
  $$b =~ tr/-\0//d;
 }    
Max

  }
hmmmm.... come dici tu: brutto è brutto per davvero! :-) A me sembra pure
abbastanza contorto, però è una mia opinione, però il benchmark dice che è
pure più lento del mio. ;-)
Prova questo:
======= CODE ========
@A = qw (
A-CDEF
-H-LMN
OP-RST
);
@B = qw (
-BCDEF
---LMN
-PQRST
);
sub dd
{
 local (@A, @B);
 foreach $i (0..$#A)
 {
  while ($A[$i] =~ /-/g) { substr ( $B[$i], (pos $A[$i]) -1, 1 ) = '-' }
  while ($B[$i] =~ /-/g) { substr ( $A[$i], (pos $B[$i]) -1, 1 ) = '-' }
  $A[$i] =~ tr/-//d;
  $B[$i] =~ tr/-//d;
 }
}
sub max
{
 local (@A, @B);
 my ($a, $b, $p); # <--- ATTENZIONE alle parentesi vedi perldoc -f my
 foreach $i( 0..$#A )
 {
  $a = \$A[$i]; $b = \$B[$i];
  $p = 0;
  while( -1 != ( $p = index $$a, '-', $p ) )
    { substr( $$b, $p++, 1 ) = "\0" }
  $p = 0;
  while( -1 != ( $p = index $$b, '-', $p ) )
    { substr( $$a, $p++, 1 ) = "\0" }
  $$a =~ tr/-\0//d;
  $$b =~ tr/-\0//d;
 }
}
use Benchmark;
timethese(1000000, {max=>"max()", dd=>"dd()"});
======== END CODE ============
Sul mio PC questo è il risultato:
Benchmark: timing 1000000 iterations of dd, max...
        dd:  7 wallclock secs ( 6.79 usr +  0.00 sys =  6.79 CPU) @
147275.41/s (n=1000000)
       max:  8 wallclock secs ( 7.81 usr +  0.00 sys =  7.81 CPU) @
128024.58/s (n=1000000)
Anche se per poco non è più rapido, quindi io userei sicuramente la versione
"bella" e lascerei perdere quella brutta, 'che mi si incrociano gli occhi
solo a cercare di decifrarla :-).


 Anche se per poco non č piů rapido, quindi io userei sicuramente la


  my ($a, $b, $p); # <--- ATTENZIONE alle parentesi vedi perldoc -f my
Ops. Erano su più righe e li ho tirati su (due secondi prima stavo
programmando in C++).
Ecco i risultati. (Poche iterazioni, a casa ho un PC anzianotto.)
 Benchmark: timing 30000 iterations of dd, max...
        dd: 26 wallclock secs (26.00 usr +  0.00 sys = 26.00 CPU)
       max: 20 wallclock secs (19.41 usr +  0.00 sys = 19.41 CPU)       
Usando due array con stringhe più lunghe (40 car anziché 6):
 Benchmark: timing 30000 iterations of dd, max...
        dd: 85 wallclock secs (84.29 usr +  0.00 sys = 84.29 CPU)
       max: 48 wallclock secs (48.13 usr +  0.00 sys = 48.13 CPU) 
(In pratica il tuo benchmark misurava l'overhead della dichiarazione my.)
Max

 
Se anziché usare la forma
    substr( String, Pos, Len ) = Replacement
usiamo 
    substr( String, Pos, Len,  Replacement )
che (lo ammetto) fino a pochi secondi fa non sapevo nemmeno che fosse
possibile, otteniamo un significativo aumento dell'efficienza (per
entrambe le funzioni, ovviamente):
 Benchmark: timing 30000 iterations of dd, max...
        dd: 75 wallclock secs (74.76 usr +  0.00 sys = 74.76 CPU)
       max: 40 wallclock secs (39.01 usr +  0.00 sys = 39.01 CPU)
Il miglioramento sarebbe in realtà più significativo. Però tra un
benchmark e l'altro ho cambiato un po' il contenuto di @A e @B aggiungendo
qualche '-' e ora non so più ripristinare il contenuto originario. ;-)
Ripristinando l'uso originario di substr() e mantenendo lo stesso
contentuto di @A e @B:
 Benchmark: timing 30000 iterations of dd, max...
        dd: 96 wallclock secs (94.64 usr +  0.00 sys = 94.64 CPU)
       max: 53 wallclock secs (52.74 usr +  0.01 sys = 52.75 CPU)    
Quindi la differenza di prestazioni tra i due usi di substr è molto
significativa.
Max
 

 significativa.
Io lo avevo letto proprio ieri mentre mi ero rispolverato la doc di substr,
però siccome non mi seviva a nulla che ritornasse il valore che sostituiva,
non avevo nemmeno pensato che potesse essere un vantaggio di velocità.
L'unico problema è che un valore in una funzione è molto meno leggibile di
un'assegnazione classica, però... tanto ormai mi hai abituato a farmi
incrociare gli occhi :-). Bbbbravo.
Comunque ho notato che facevamo una cosa un po' tonta, anche se non molto
pesante: perché sostituire in entrambe le stringhe lo stesso carattere?
io facevo:
  while ($A[$_] =~ /-/g) { substr ( $B[$_], (pos $A[$_]) -1, 1, "-") }
  while ($B[$_] =~ /-/g) { substr ( $A[$_], (pos $B[$_]) -1, 1, '-') }
  $A[$_] =~ tr/-//d;
  $B[$_] =~ tr/-//d;
In questo modo i caratteri '-' trovati in A e sostituiti in B, sono
inutilmente risostituiti in A quando trovati in B.
tu facevi:
  while( -1 != ( $p = index $$a, '-', $p ) )
    { substr( $$b, $p++, 1, "\0") }
  $p = 0;
  while( -1 != ( $p = index $$b, '-', $p ) )
    { substr( $$a, $p++, 1, "\0") }
  $$a =~ tr/-\0//d;
  $$b =~ tr/-\0//d;
in questo modo dovrai poi cancellare sia '-' sia "\0" da entrambe le
stringhe. La cosa più logica sarebbe inserire in B "\0", e inserire '-' in
A, così poi in A elimini solo i '-' e in B elimini '-' e "\0".
  while( -1 != ( $p = index $$a, '-', $p ) )
    { substr( $$b, $p++, 1, "\0") }
  $p = 0;
  while( -1 != ( $p = index $$b, '-', $p ) )
    { substr( $$a, $p++, 1, '-') }
  $$a =~ tr/-//d;
  $$b =~ tr/-\0//d;
il vantaggio in velocità è minimo, però è più logico.
però adesso basta con sto c***o di algoritmo che non sappiamo nemmeno a cosa
serve in pratica! :-))))
ciao


 a cosa serve in pratica! :-))))
Ecco, appunto. Ora Giuseppe dovrebbe spiegarci a che serviva implementare
quella trasformazione, ché sono diventato un po' curioso. :-)
Max

 wrote in message news:<Pine.LNX.4.21.02100...@localhost.localdomain>...

Ho seguito il Thread (imparando moltissimo) e... 
anche io vorrei conoscere lo scopo del gioco :)
Comunque, ho fatto qualche prova e questa soluzione sembra 
essere molto veloce.
(E' limitata, in quanto funziona solo su stringhe 
alfanumeriche)
sub mm()
 {
  my @A = @::A;
  my @B = @::B;
        foreach $i( 0..$#A ) {
                $a = \$A[$i]; $b = \$B[$i];
                $pa = $A[$i]; $pb = $B[$i];
                $pa =~ tr/[a-zA-Z0-9]/\xff/;
                $pa =~ tr/-/\x00/;
                $pb =~ tr/[a-zA-Z0-9]/\xff/;
                $pb =~ tr/-/\x00/;
                $pa &= $pb;
                $$a &= $pa;
                $$b &= $pa;
                $$a =~ tr/\x00//;
                $$b =~ tr/\x00//;
        }
 }
Marco

                 $$b =~ tr/\x00//;
forse volevi dire:
                $$a =~ tr/\x00//d;
                 $$b =~ tr/\x00//d;
Comunque... va come una scheggia ed è esattamente GENIALE! Complimenti! Hai
solo usato tr/// ed & (rapidissimi entrambi), ed era tutto quello che
serviva, senza tirare in ballo posizioni e index vari.
Anch'io ho imparato moltissimo! Grazie mille.


 mi sembra proprio di no :-)
A me sembra proprio di si, l'unica differenza con i vostri codici e' 
che occorre una nuova iterazione su $b (while ($b=~....)), per il resto 
mi sembra che l'effetto sia uguale.
Per altro, riprendendo il tuo benchmark, trovo che il mio codice eì, 
ovviamente ;-), il piu' veloce.
-- 
Saluti,
Giancarlo

Forse non mi sono spiegato bene: per funzionare funziona, solo che è 4 volte
più lenta della più lenta :-).
======= CODE ========
@A = qw (
A-CSEF
-H-QMN
OP-RST
);
@B = qw (
-BWDEF
---LMA
-PQRNT
);
sub dd
{
  my @A = @::A;
  my @B = @::B;
 foreach (0..$#A)
 {
  while ($A[$_] =~ /-/g) { substr ( $B[$_], (pos $A[$_]) -1, 1 ) = "\0" }
  while ($B[$_] =~ /-/g) { substr ( $A[$_], (pos $B[$_]) -1, 1 ) = '-' }
  $A[$_] =~ tr/-//d;
  $B[$_] =~ tr/-\0//d;
 }
}
sub max
{
 my @A = @::A;
  my @B = @::B;
 my ($a, $b, $p);
 foreach $i( 0..$#A )
 {
  $a = \$A[$i]; $b = \$B[$i];
  $p = 0;
  while( -1 != ( $p = index $$a, '-', $p ) )
    { substr( $$b, $p++, 1 ) = "\0" }
  $p = 0;
  while( -1 != ( $p = index $$b, '-', $p ) )
    { substr( $$a, $p++, 1 ) = "-" }
  $$a =~ tr/-//d;
  $$b =~ tr/-\0//d;
 }
}
sub mm
{
 my @A = @::A;
 my @B = @::B;
 foreach ( 0..$#A )
 {
         $a = \$A[$_]; $b = \$B[$_];
         $pa = $A[$_]; $pb = $B[$_];
         $pa =~ tr/[a-zA-Z0-9]/\xff/;
         $pa =~ tr/-/\x00/;
         $pb =~ tr/[a-zA-Z0-9]/\xff/;
         $pb =~ tr/-/\x00/;
         $pa &= $pb;
         $$a &= $pa;
         $$b &= $pa;
         $$a =~ tr/\x00//d;
         $$b =~ tr/\x00//d;
 }
}
sub gc
{
 my @A = @::A;
 my @B = @::B;
  foreach (0..$#A)
  {
  while ($A[$_]=~s/^([^-]*)\-/$1/) {
          $len=length($1);
          $B[$_]=~s/^(.{$len})./$1/;
  }
  while ($B[$_]=~s/^([^-]*)\-/$1/) {
          $len=length($1);
          $A[$_]=~s/^(.{$len})./$1/;
  }
   $A[$_] =~ tr/-//d;
   $B[$_] =~ tr/-//d;
 }
}
use Benchmark;
timethese 30000, {dd=>"dd()", mm=>"mm()", max=>"max()", gc=>"gc()"};
__END__
Benchmark: timing 30000 iterations of dd, gc, max, mm...
        dd:  2 wallclock secs ( 1.86 usr +  0.00 sys =  1.86 CPU) @
16111.71/s (n=30000)
        gc:  8 wallclock secs ( 7.44 usr +  0.00 sys =  7.44 CPU) @
4031.72/s (n=30000)
       max:  2 wallclock secs ( 1.78 usr +  0.00 sys =  1.78 CPU) @
16825.57/s (n=30000)
        mm:  1 wallclock secs ( 1.20 usr +  0.00 sys =  1.20 CPU) @
24958.40/s (n=30000)
======== END CODE ========


 volte più lenta della più lenta :-).
E' vero, avevi clamorosamente sbagliato il codice del benchmark di 
prima pero'...e io scemo che l'ho copato uguale.
Perche' poi al mio hai aggiunto i tr finali? 
-- 
Saluti,
Giancarlo

 Perche' poi al mio hai aggiunto i tr finali?
perché non mi sembrava che lo facesse da solo :-)


 perché non mi sembrava che lo facesse da solo :-)
Ma non serviva che lo facesse.
-- 
Saluti,
Giancarlo

 Ma non serviva che lo facesse.
Avevo capito!!!! Volevi sapere perché ho aggiunto i tr e io ti ho detto che
è stato "perché non mi sembrava che lo facesse da solo :-)" cosa che vuol
proprio dire che non mi sembrava, non che non lo faceva ;-)... e ci ho pure
aggiunto un :-) di auto-ironia.
ciao


 
Gia' :(
Credo di aver sbagliato anche le tr precedenti.
La sintassi corretta dovrebbe essere:
tr/a-zA-Z0-9/\xff/
Ancora meglio, per evitare la doppia tr con \x00 e \xff:
tr/-a-zA-Z0-9/\x00\xff/
un saluto
Marco