Foro - Perl en Español

La comunidad de programadores en Perl de habla hispana.

Obviar


  • Publicidad

Agrupamiento por bloques

¿Apenas comienzas con Perl? En este foro podrás encontrar y hacer preguntas básicas de Perl con respuestas aptas a tu nivel.
Publicar una respuesta

Agrupamiento por bloques

Notapor canec » 2013-01-21 12:25 @559

Hola, buen día.

Tengo tiempo visitando el foro y me ha servido de mucho en este camino de aprendizaje. En esta ocasión escribo para solicitar ayuda con un problema que tengo al momento de agrupar la información que leo de un archivo, estos son los datos de entrada.

Sintáxis: [ Descargar ] [ Ocultar ]
Using text Syntax Highlighting
SDAPQ111111|9502|2678402|1|Cap. Adicional|20120125|
SDAPQ111111|9502|2678402|1|Cap. Adicional|20120126|
SDAPQ111111|9502|2678402|1|Cap. Adicional|20120127|
SDAPQ111111|9502|2678402|1|Cap. Adicional|20120128|
SDAPQ111111|9502|2678402|1|Cap. Adicional|20120129|
SDAPQ111111|9502|2678402|1|Cap. Adicional|20120130|
SDAPQ111111|9502|2678402|1|Cap. Adicional|20120131|
SDAPQ111111|9502|2678402|5|Cap. Adicional|20120115|
SDAPQ111111|9502|2678402|5|Cap. Adicional|20120116|
SDAPQ111111|9502|2678402|5|Cap. Adicional|20120117|
SDAPQ111111|9502|2678402|5|Cap. Adicional|20120118|
SDAPQ111111|9502|2678402|5|Cap. Adicional|20120119|
SDAPQ111111|9502|2678402|5|Cap. Adicional|20120120|
SDAPQ111111|9502|2678402|5|Cap. Adicional|20120121|
SDAPQ111111|9502|2678402|5|Cap. Adicional|20120122|
SDAPQ111111|9502|2678402|5|Cap. Adicional|20120123|
SDAPQ111111|9502|2678402|5|Cap. Adicional|20120124|
SDAPQ111111|9502|2678402|1|Cap. Adicional|20120103|
SDAPQ111111|9502|2678402|1|Cap. Adicional|20120104|
SDAPQ111111|9502|2678402|1|Cap. Adicional|20120105|
SDAPQ111111|9502|2678402|1|Cap. Adicional|20120106|
SDAPQ111111|9502|2678402|1|Cap. Adicional|20120107|
SDAPQ111111|9502|2678402|1|Cap. Adicional|20120108|
SDAPQ111111|9502|2678402|1|Cap. Adicional|20120109|
SDAPQ111111|9502|2678402|1|Cap. Adicional|20120110|
SDAPQ111111|9502|2678402|1|Cap. Adicional|20120111|
SDAPQ111111|9502|2678402|1|Cap. Adicional|20120112|
SDAPQ111111|9502|2678402|1|Cap. Adicional|20120113|
SDAPQ111111|9502|2678402|1|Cap. Adicional|20120114|
SDAPQ111112|9502|2678402|1|Cap. Adicional|20120125|
SDAPQ111112|9502|2678402|1|Cap. Adicional|20120126|
SDAPQ111112|9502|2678402|1|Cap. Adicional|20120127|
SDAPQ111112|9502|2678402|1|Cap. Adicional|20120128|
SDAPQ111112|9502|2678402|1|Cap. Adicional|20120129|
SDAPQ111112|9502|2678402|1|Cap. Adicional|20120130|
SDAPQ111112|9502|2678402|1|Cap. Adicional|20120131|
SDAPQ111112|9502|2678402|5|Cap. Adicional|20120115|
SDAPQ111112|9502|2678402|5|Cap. Adicional|20120116|
SDAPQ111112|9502|2678402|5|Cap. Adicional|20120117|
SDAPQ111112|9502|2678402|5|Cap. Adicional|20120118|
SDAPQ111112|9502|2678402|5|Cap. Adicional|20120119|
SDAPQ111112|9502|2678402|5|Cap. Adicional|20120120|
SDAPQ111112|9502|2678402|5|Cap. Adicional|20120121|
SDAPQ111112|9502|2678402|5|Cap. Adicional|20120122|
SDAPQ111112|9502|2678402|5|Cap. Adicional|20120123|
SDAPQ111112|9502|2678402|5|Cap. Adicional|20120124|
SDAPQ111112|9502|2678402|1|Cap. Adicional|20120103|
SDAPQ111112|9502|2678402|1|Cap. Adicional|20120104|
SDAPQ111112|9502|2678402|1|Cap. Adicional|20120105|
SDAPQ111112|9502|2678402|1|Cap. Adicional|20120106|
SDAPQ111112|9502|2678402|1|Cap. Adicional|20120107|
SDAPQ111112|9502|2678402|1|Cap. Adicional|20120108|
SDAPQ111112|9502|2678402|1|Cap. Adicional|20120109|
SDAPQ111112|9502|2678402|1|Cap. Adicional|20120110|
SDAPQ111112|9502|2678402|1|Cap. Adicional|20120111|
SDAPQ111112|9502|2678402|1|Cap. Adicional|20120112|
SDAPQ111112|9502|2678402|1|Cap. Adicional|20120113|
SDAPQ111112|9502|2678402|1|Cap. Adicional|20120114|
Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4


Lo que he logrado es hacer un agrupamiento en base a los 5 primeros datos de cada registro, agregando un contador para saber cuantos registros son en total y obtengo.

Sintáxis: [ Descargar ] [ Ocultar ]
Using text Syntax Highlighting
SDAPQ111111|9502|Cap. Adicional|1|20120125|19|
SDAPQ111111|9502|Cap. Adicional|5|20120115|10|
SDAPQ111112|9502|Cap. Adicional|1|20120125|19|
SDAPQ111112|9502|Cap. Adicional|5|20120115|10|
Coloreado en 0.000 segundos, usando GeSHi 1.0.8.4


Sin embargo, el resultado que necesito obtener es:

Sintáxis: [ Descargar ] [ Ocultar ]
Using text Syntax Highlighting
SDAPQ111111|9502|Cap. Adicional|1|20120125|7|
SDAPQ111111|9502|Cap. Adicional|5|20120115|10|
SDAPQ111111|9502|Cap. Adicional|1|20120103|12|
SDAPQ111112|9502|Cap. Adicional|1|20120125|7|
SDAPQ111112|9502|Cap. Adicional|5|20120115|10|
SDAPQ111112|9502|Cap. Adicional|1|20120103|12|
Coloreado en 0.000 segundos, usando GeSHi 1.0.8.4


El último campo del registro de entrada corresponde a la fecha, entonces, si las fechas no son consecutivas debe de cerrarse un bloque y abrir otro, pero como en mi lógica utilizo el !exists, al momento de entrar pues lo mete en la parte de hash existente. Agradezco de antemano si pueden echarme una ayuda. Saludos.
canec
Perlero nuevo
Perlero nuevo
 
Mensajes: 3
Registrado: 2013-01-21 11:57 @539
Arriba

Publicidad

Re: Agrupamiento por bloques

Notapor explorer » 2013-01-21 15:20 @681

Bienvenida a los foros de Perl en Español, canec.

No entiendo lo que dices con respecto a "los 5 primeros campos".

Si te refieres a los campos que están separados por el delimitador '|', resulta que el cuarto campo también cambia con respecto a la fecha, así que se están dando dos circunstancias de cambio, a la vez.
JF^D Perl programming & Raku programming. Grupo en Telegram: https://t.me/Perl_ES
Avatar de Usuario
explorer
Administrador
Administrador
 
Mensajes: 14480
Registrado: 2005-07-24 18:12 @800
Ubicación: Valladolid, España
Arriba

Re: Agrupamiento por bloques

Notapor canec » 2013-01-21 15:52 @703

¿Qué tal, explorer? Gracias por responder. Así es, me refiero al separador por '|'. De hecho, el cambio es en base al campo #4, pero no he podido lograr que me genere el agrupado cada que existe un cambio en el campo #4.

Esto es lo que tengo actualmente

$external_id_d=$a[0];
$point_target=$a[2];
$cantidad=$a[3];
$annotation=$a[4];

if ( !exists $hs01495_DET_INS{$external_id_d.$point_target.$annotation.$cantidad}){
#print "Es nuevo\n";
$hs01495_DET_INS{$external_id_d.$point_target.$annotation.$cantidad}=$external_id_d;
$hs01495_DET_TIU{$external_id_d.$point_target.$annotation.$cantidad}=$type_id_usg;
$hs01495_DET_ANT{$external_id_d.$point_target.$annotation.$cantidad}=$annotation;
$hs01495_DET_CAN{$external_id_d.$point_target.$annotation.$cantidad}=$cantidad;
$hs01495_DET_MES{$external_id_d.$point_target.$annotation.$cantidad}=$date;
$hs01495_DET_EVE{$external_id_d.$point_target.$annotation.$cantidad}=1;
} else {
#print "Ya existe\n";
$hs01495_DET_EVE{$external_id_d.$point_target.$annotation.$cantidad}++;
}
canec
Perlero nuevo
Perlero nuevo
 
Mensajes: 3
Registrado: 2013-01-21 11:57 @539
Arriba

Re: Agrupamiento por bloques

Notapor explorer » 2013-01-21 16:00 @708

Pero si antes has dicho que el cambio debe realizarse cuando las fechas no son consecutivas...
JF^D Perl programming & Raku programming. Grupo en Telegram: https://t.me/Perl_ES
Avatar de Usuario
explorer
Administrador
Administrador
 
Mensajes: 14480
Registrado: 2005-07-24 18:12 @800
Ubicación: Valladolid, España
Arriba

Re: Agrupamiento por bloques

Notapor explorer » 2013-01-21 16:21 @723

Esta es una solución, atendiendo solo al cambio de las fechas correlativas:
Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1. #!/usr/bin/perl
  2. use v5.14;
  3. use autodie;                    # «Es mejor morir que regresar con deshonor» --proverbio Klingon
  4.  
  5. use DateTime;                   # Gestión de fechas
  6.  
  7. my @seccion;
  8. my $registro_anterior = '';
  9. my $fecha_siguiente   = '';
  10. my $dt;
  11.  
  12. open my $FILE, '<', 'code_33627.txt';
  13.  
  14. while (my $linea = <$FILE>) {                  # Recorremos todas las líneas
  15.     chomp $linea;                              # Quitamos el carácter de fin de línea
  16.  
  17.     # SDAPQ111112|9502|2678402|1|Cap. Adicional|20120111|
  18.     # Partimos la línea, entre la fecha y el resto del registro
  19.     my($registro, $fecha) = $linea =~ /^((?:.+?\|){5})(.+?)\|/;
  20.  
  21.     # Si hay alguna diferencia entre este registro y el anterior,
  22.     # o la fecha que contiene no es correlativa...
  23.     if ($registro ne $registro_anterior  or  $fecha_siguiente ne $fecha) {
  24.         suma_seccion();                                     # Hacemos la presentación de la sección
  25.         my($y,$m,$d) = unpack "A4A2A2", $fecha;             # Calculamos el nuevo objeto DateTime
  26.         $dt = DateTime->new(year=>$y, month=>$m, day=>$d);  # correspondiente a $fecha
  27.     }
  28.  
  29.     push @seccion, $linea;                                       # La $linea es almacenada en @seccion
  30.     $fecha_siguiente = $dt->add(days => 1)->strftime("%Y%m%d");  # Calculamos la $fecha_siguiente
  31.     $registro_anterior = $registro;                              # El $registro_anterior es igual a $registro
  32. }
  33.  
  34. close $FILE;
  35.  
  36. suma_seccion();                                   # Pintamos la última @seccion
  37.  
  38.  
  39. sub suma_seccion {
  40.     return if not @seccion;                       # Caso de la primera línea
  41.  
  42.     say $seccion[0], "|", scalar(@seccion), "|";  # Pintamos la @seccion
  43.  
  44.     @seccion = ();                                # Reiniciamos
  45. }
  46.  
  47. __END__
  48. SDAPQ111111|9502|2678402|1|Cap. Adicional|20120125||7|
  49. SDAPQ111111|9502|2678402|5|Cap. Adicional|20120115||10|
  50. SDAPQ111111|9502|2678402|1|Cap. Adicional|20120103||12|
  51. SDAPQ111112|9502|2678402|1|Cap. Adicional|20120125||7|
  52. SDAPQ111112|9502|2678402|5|Cap. Adicional|20120115||10|
  53. SDAPQ111112|9502|2678402|1|Cap. Adicional|20120103||12|
Coloreado en 0.004 segundos, usando GeSHi 1.0.8.4
JF^D Perl programming & Raku programming. Grupo en Telegram: https://t.me/Perl_ES
Avatar de Usuario
explorer
Administrador
Administrador
 
Mensajes: 14480
Registrado: 2005-07-24 18:12 @800
Ubicación: Valladolid, España
Arriba

Re: Agrupamiento por bloques

Notapor canec » 2013-01-21 17:43 @780

Gracias por la atención explorer, ¡creo que hice algo muy rebuscado, je,je! Me quedó algo así (antes de ver tu respuesta)

Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1. if ( !exists $hs01495_DET_INS{ $external_id_d . $point_target . $annotation . $cantidad . $flag_d } ) {
  2.  
  3.     #print "Es nuevo\n";
  4.     $count = 1;
  5.     $flag_d++;
  6.     $reset  = 0;
  7.     $cant1  = $cantidad;
  8.     $date_i = $date;
  9.  
  10.     $hs01495_DET_INS{ $external_id_d . $point_target . $annotation . $cantidad . $flag_d } = $external_id_d;
  11.     $hs01495_DET_TIU{ $external_id_d . $point_target . $annotation . $cantidad . $flag_d } = $type_id_usg;
  12.     $hs01495_DET_ANT{ $external_id_d . $point_target . $annotation . $cantidad . $flag_d } = $annotation;
  13.     $hs01495_DET_CAN{ $external_id_d . $point_target . $annotation . $cantidad . $flag_d } = $cantidad;
  14.     $hs01495_DET_MES{ $external_id_d . $point_target . $annotation . $cantidad . $flag_d } = $date;
  15.     $hs01495_DET_EVE{ $external_id_d . $point_target . $annotation . $cantidad . $flag_d } = 1;
  16. }
  17. else {
  18.  
  19.     #print "Ya existe\n";
  20.     $count++;
  21.     $date_p = $date_i + $count;
  22.     if ( $date_p - $date > 1 && $reset == 0 && $cant1 != $cantidad ) {
  23.         $flag_d++;
  24.         $reset++;
  25.     }
  26.     $hs01495_DET_EVE{ $external_id_d . $point_target . $annotation . $cantidad . $flag_d }++;
  27. }
  28.  
Coloreado en 0.002 segundos, usando GeSHi 1.0.8.4


En el ejemplo que hiciste el favor de hacer, no visualizo donde incrementas el contador que pinta al final de la línea, supongo que eso de irlo incrementando como lo hago yo está muy primitivo ¿o que onda?
Última edición por explorer el 2013-01-21 20:03 @877, editado 2 veces en total
Razón: Formateado de código con Perltidy y poner marcas Perl
canec
Perlero nuevo
Perlero nuevo
 
Mensajes: 3
Registrado: 2013-01-21 11:57 @539
Arriba

Re: Agrupamiento por bloques

Notapor explorer » 2013-01-21 21:10 @923

Bueno, el código sí que está un poco enrevesado, pero el mío también puede ser complicado de entender.

Hay algunos detalles a destacar del tuyo:

Usas varios hash para guardar la información por separado, cuando solo necesitas uno: podrías guardar todos los datos en un array anónimo, y ese guardarlo como valor dentro del hash.

Pero el problema mayor que tienes es el del cálculo de la fecha... ¿qué ocurre en una secuencia que pase por el límite de un mes? Por ejemplo, si una secuencia empieza el día 25 de enero, y sigue 8 días, la secuencia será

20120125
20120126
20120127
20120128
20120129
20120130
20120131
20120201

Y ya ves que del día 31 de enero al 1 de febrero, la diferencia en las cifras de la fecha no son 1, sino 70.

En mi código yo utilizo el módulo DateTime para que me diga exactamente cuál es el día siguiente a uno dado.

Por otra parte, parece que tienes dos contadores... $count y el valor almacenado en %hs01495_DET_EVE. Y no soy capaz de entender las diferencias entre $flag_d y $reset.

Por resolverlo, se puede hacer de muchas maneras, y mientras funcione, no importa mucho si es bonita o no la solución...

Yo lo que hago es guardar cada $linea que tiene una serie de registros iguales a los de la línea anterior, pero si son distintos o si la fecha no es consecutiva, imprime la sección y reinicia el array para guardar las líneas de la siguiente sección.

No tiene en cuenta lo del cambio del campo cantidad, pero sería cuestión de añadir un par de variables más.
JF^D Perl programming & Raku programming. Grupo en Telegram: https://t.me/Perl_ES
Avatar de Usuario
explorer
Administrador
Administrador
 
Mensajes: 14480
Registrado: 2005-07-24 18:12 @800
Ubicación: Valladolid, España
Arriba
Publicar una respuesta

Volver a Básico

¿Quién está conectado?

Usuarios navegando por este Foro: No hay usuarios registrados visitando el Foro y 30 invitados

Powered by phpBB® Forum Software © phpBB Group
Traducción al Español Mexicano por nextgen en colaboración con phpbb-es.com
phpBB SEO
Advertisements by Advertisement Management