Foro - Perl en Español

por **merentah** » 2008-10-16 04:50 @243

Hola, tengo un código en que un array (@h2) tiene una serie de elementos que a su vez contienen un array de direcciones de memoria. Ahora quiero recorrer todo el array y eliminar todo elemento cuyas direcciones de memoria ya estén incluidas en otro elemento. Por ejemplo, si tengo el elemento: d1, d2, d3 y otro elemento d1,d3.
Este segundo quiero que lo elimine, porque ya está incluido en el primero. Y si tengo otro que sea: d1, d2, d3, d4 quiero que elimine el primero ya que ese primero está incluido en este último.
El caso es que lo he implementado con grep() (código de abajo) y el script va superlento cuando tengo muchos elementos. ¿Se os ocurre otra estrategia para resolver el problema?
Gracias por adelantado,

Iam.

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

# Check for repeated or inclusive windows
my$repeat=0;
for(my$i=0;$i<=$#w;$i++){
my$rep=0;
foreachmy$h2(@h2){
nextunless(grep/$h2/,@{$w[$i]});
$rep++;
}
if($rep==$#h2+1){# for repeated window
$repeat=1;
last;
}elsif($rep==$#{$w[$i]}+1){# for new window larger than a previous one
splice(@w,$i, 1);
next;
}
}

# Only non-repeated window (good result)
nextif($repeat== 1 ||$#h2< 1);
push@w,\@h2;Coloreado en 0.002 segundos,  usando GeSHi 1.0.8.4

# Check for repeated or inclusive windows
my$repeat=0;

my%seen;

for(my$i=0;$i<=$#w;$i++){
my$rep=0;

foreachmy$h2(@h2){
nextif$seen{$h2};;
$rep++;
$seen{$h2}=1;
}

if($rep==$#h2+1){# for repeated window
$repeat=1;
last;
}elsif($rep==$#{$w[$i]}+1){# for new window larger than a previous one
splice(@w,$i, 1);
next;
}
}Coloreado en 0.001 segundos,  usando GeSHi 1.0.8.4

por **merentah** » 2008-10-16 09:02 @418

El problema es que elementos individuales sí que pueden repetirse, pero no colecciones completas. Por ejemplo, si ya he cogido la colección d1, d2, d3, esta otra colección ya no la quiero: d1, d2. Sin embargo, esta otra sí: d1, d2, d4.

por **salva** » 2008-10-16 10:45 @489

Aquí va un algoritmo que permite hacer lo que tu quieres, aunque tendrás que adaptarlo para que funcione con tu tipo de datos específico:

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

use Data::Dumper;

# Generamos algunos datos de ejemplo. Nótese que están ordenados, si no
# fuese así, habría que ordenarlos para que el algoritmo funcione.
my@data=map[greprand>.7, 1..7], 1..25;

# Ordenamos @data por el numero de elementos en cada array.
# En el fondo lo que vamos a comprobar es si un conjunto A es un
# subconjunto de otro B y eso implica que el número de elementos de A
# <= num. elem. de B y así nos ahorramos la mitad de las operaciones.
@data=sort{@$a<=>@$b}@data;

# Convertimos los datos de un array a una cadena de manera que podamos
# procesarla usando regexps:
@data=mapjoin(',',@$_,''),@data;

print Dumper \@data;

my@unique;# aquí vamos guardando los conjuntos que no son
# subconjuntos de ningún otro
for(@data){
# generamos una expresión regular que nos permite ver si un
# conjunto es subconjunto de otro
my@parts=split/,/;
my$re_str=join'',map'(?:'.quotemeta($_).',)?',@parts;
my$re=qr/^$re_str$/;

# y la usamos para filtrar los elementos de @unique
@unique=grep$_!~$re,@unique;

# finalmente añadimos el elemento actual a la lista de conjuntos
# @unique dado que como es el más grande examinado hasta el
# momento, no puede ser subconjunto de ningún otro:
push@unique,$_;
}

print Dumper \@unique;Coloreado en 0.001 segundos,  usando GeSHi 1.0.8.4

La complejidad del algoritmo es O(N^2), no se me ocurre otra forma más eficiente de hacerlo

por **salva** » 2008-10-16 11:07 @505

Otra implementación que cambia el orden en el que las repeticiones son descartadas y que es más eficiente.

En el peor caso sigue siendo O(N^2) pero para casos con alto número de repeticiones tiende a O(N):

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

use Data::Dumper;

my@data=map[greprand>.7, 1..7], 1..25;
@data=sort{@$a<=>@$b}@data;
@data=mapjoin(',',@$_,''),@data;

print Dumper \@data;

my@unique;
while(@data){
my$top=pop@data;
unshift@unique,$top;
my@parts=split/,/,$top;
my$re_str=join'',map'(?:'.quotemeta($_).',)?',@parts;
my$re=qr/^$re_str$/;
@data=grep$_!~$re,@data;
}

print Dumper \@unique;Coloreado en 0.001 segundos,  usando GeSHi 1.0.8.4

Actualización: si tus conjuntos se pueden representar como una cadena de bits (por ejemplo, si son enteros pequeños), entonces, el algoritmo se podría hacer aun más eficaz usando esa representación y operaciones booleanas para comprobar cuándo un conjunto es subconjunto de otro.

por **explorer** » 2008-10-16 11:17 @512

Yo he usado teoría de conjuntos

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

#!/usr/bin/perl
use strict;
use warnings;
use diagnostics;

use Data::Dumper::Names;
use Set::Scalar;

my@w=(
[qw(d2 d3 d5)],
[qw(d1 d3 d4)],
[qw(d1 d2   )],
[qw(d1 d5   )],
);

my@h2=(
[qw(d1 d2      )],
[qw(d1 d2 d3   )],
[qw(d1 d2 d4   )],
[qw(d1 d2 d3 d4)],
[qw(d1         )],
);

## Convertimos las secuencias originales en objetos
my@w_set
=map{

            Set::Scalar->new(@$_)
}@w
;
my@h2_set
=map{

            Set::Scalar->new(@$_)
}@h2
;

## Bucle para todo lo nuevo
formy$h2_set(@h2_set){
print"$h2_set\n";

## Bucle para todo lo viejo
my$encontrado;
formy$i(0 ..$#w_set){
my$w_set=$w_set[$i];
print"\t$w_set -> ";

## Comparación
my$comparacion=$h2_set<=>$w_set;

if($comparacioneq'proper superset'){# Encontrado superconjunto
if(!$encontrado){
$w_set[$i]=$h2_set;# Lo sobreescribimos
print"$h2_set+\n";
$encontrado=1;
}
else{
delete$w_set[$i];
print"><\n";
}
next;
}
elsif($comparacioneq'proper subset'# Encontrado subconjunto
or$comparacioneq'equal'){# o conjuntos iguales
print"$h2_set<=\n";
undef$h2_set;# Nos lo cargamos
last;
}

print"\n";
}

## Si no hemos encontrado coincidencia, lo agregamos
if($h2_setand!$encontrado){
push@w_set,$h2_set;
print"\t\t+$h2_set\n";
}
}

## Deshacemos
@w=
grep{$_}
map{
$_?[sort$_->members]:''
}@w_set
;

print Dumper \@w;Coloreado en 0.002 segundos,  usando GeSHi 1.0.8.4

Sale:

Código: Seleccionar todo: (d1 d2) (d2 d3 d5) -> (d1 d3 d4) -> (d1 d2) -> (d1 d2)<= (d1 d2 d3) (d2 d3 d5) -> (d1 d3 d4) -> (d1 d2) -> (d1 d2 d3)+ (d1 d5) -> (d1 d2 d4) (d2 d3 d5) -> (d1 d3 d4) -> (d1 d2 d3) -> (d1 d5) -> +(d1 d2 d4) (d1 d2 d3 d4) (d2 d3 d5) -> (d1 d3 d4) -> (d1 d2 d3 d4)+ (d1 d2 d3) -> >< (d1 d5) -> (d1 d2 d4) -> >< (d1) (d2 d3 d5) -> (d1 d2 d3 d4) -> (d1)<= @w = ( [ 'd2', 'd3', 'd5' ], [ 'd1', 'd2', 'd3', 'd4' ], [ 'd1', 'd5' ] );

El programa va sustituyendo los conjuntos con los superconjuntos que va encontrando. Si un elemento no está, se agrega.

Actualización: Ya encontré la forma de eliminar los conjuntos de @w que son subconjuntos de otros. Ahora ya sale la solución mínima. Y salen ordenados con la adición del sort().

Actualización: Volviendo a leer el problema, ahora me surge la duda de si merentah se refería a un solo array o a dos, porque en el código suyo he visto dos. Bueno, da igual, se hace @h2 = @w al principio, y listo.

por **merentah** » 2008-10-17 11:34 @524

Muchas gracias, este fin de semana lo intento adaptar y ya os cuento. Aunque llevo años programando en Perl, no soy informático y hay funciones como map() que no estoy habituado a usar. Además, lo de los conjuntos me ha gustado y voy a probarlo también.
Realmente utilizo un sólo array, lo que pasa es que desde el inicial (h2) creo el segundo (w) para quedarme con los conjuntos no redundantes.
Un saludo y gracias de nuevo,

Iam.

por **explorer** » 2008-10-17 20:52 @911

¡Ah!, pues si es un solo array, la solución es más sencilla:

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

#!/usr/bin/perl
use strict;
use warnings;
use diagnostics;

use Data::Dumper;
use Set::Scalar;

my@h2=(
[qw(d1 d5      )],
[qw(d1 d2      )],
[qw(d1 d2 d3   )],
[qw(d1 d3 d4   )],
[qw(d2 d3 d5   )],
[qw(d1 d2 d4   )],
[qw(d1 d2 d3 d4)],
[qw(d1         )],
);

## Convertimos las secuencias originales en objetos
@h2=map{ Set::Scalar->new(@$_)}@h2;

for(my$i=0;$i<@h2;$i++){
my$h2=$h2[$i]ornext;
print"$h2 ";

for(my$j=0;$j<@h2;$j++){
my$w=$h2[$j]ornext;

nextif$i==$j;

if($h2>=$w){
delete$h2[$j];
print" del $h2 >= $w";
}
elsif($h2<$w){
delete$h2[$i];
print" del $h2 < $w";
last;
}
}
print"\n";
}

## Deshacemos
@h2=map{[sort$_->members]}grep{$_}@h2;
print Dumper \@h2;Coloreado en 0.001 segundos,  usando GeSHi 1.0.8.4

por **merentah** » 2008-10-18 11:48 @533

Magnífico, funciona mucho mejor que lo que yo tenía. Ahora sólo me queda entender todo el código. Gracias,

Iam.

por **explorer** » 2008-10-18 16:49 @742

Hay cosillas ocultas, como lo de usar '<=' y '>', que están siendo sobrecargados por el módulo Set::Scalar.

Y otro detalle es ver que, en situaciones normales, si en un 'if' tenemos una condición '<=', se supone que la alternativa no sería necesario poner otro 'if' para ver si es '>', pero es que en nuestro caso estamos hablando de conjuntos, así que no se trata de comparaciones numéricas, sino diferencias entre conjuntos: si un conjunto no es superconjunto de otro, no implica que sea un subconjunto. Podrían ser disjuntos.

No he visto cómo hace Set::Scalar para realizar su labor, pero sería interesante saber el ratio de mejora de velocidad con respecto a lo tuyo. Y luego ver si puedes probar la solución de salva, usando la opción de las expresiones regulares.

Foro - Perl en Español

Comprobar varios elementos de un array

Comprobar varios elementos de un array

Publicidad

¿Quién está conectado?