• Publicidad

Recorrido comparando varias líneas entre sí

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

Recorrido comparando varias líneas entre sí

Notapor roxana_ » 2010-11-04 15:21 @681

Tengo un archivo con el siguiente formato:
Sintáxis: [ Descargar ] [ Ocultar ]
Using text Syntax Highlighting
Familia Nombre cobertura resolución
1         bovin       0.8         1.2
1         human       1           2.5
1         ecoli       1           2
2         ecoli       0.7         1.5
2         mouse       1           3
5         human       1           2.7
Coloreado en 0.000 segundos, usando GeSHi 1.0.8.4

Necesito, para cada Familia distinta (1, 2 y 5), la línea con mejor cobertura (número más próximo a 1) y como segundo criterio, mejor resolución (más próximo a cero). La salida deseada sería:
Sintáxis: [ Descargar ] [ Ocultar ]
Using text Syntax Highlighting
Familia  Nombre cobertura resolución
1          ecoli      1            2
2          mouse      1            3
5          human      1            2.7
Coloreado en 0.000 segundos, usando GeSHi 1.0.8.4


Mi problema es cómo hacer el recorrido, guardar siempre el mejor dato y luego cambiar de familia. ¿Alguna sugerencia?
roxana_
Perlero nuevo
Perlero nuevo
 
Mensajes: 14
Registrado: 2010-11-04 15:18 @679

Publicidad

Re: Recorrido comparando varias líneas entre sí

Notapor explorer » 2010-11-04 15:42 @696

Bienvenido a los foros de Perl en Español, roxana_.

Deberías explicar un poco lo que significa "más próximo", porque, si tenemos en cuenta a la recta de los reales, 1,1 está más próximo a 1, que 0,7. Deberías indicar el signo de la aproximación. O quizás tienes razón y "más próximo" se refiere a distancia, en cualquiera de los dos sentidos.

En ese caso, a mí me sale un resultado distinto:
Sintáxis: [ Descargar ] [ Ocultar ]
Using text Syntax Highlighting
Familia Nombre cobertura resolución
1       bovin   0.8     1.2
2       ecoli   0.7     1.5
5       human   1       2.7
Coloreado en 0.000 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

Re: Recorrido comparando varias líneas entre sí

Notapor roxana_ » 2010-11-04 15:51 @702

Por más próximo me refiero al valor más cercano a 1, sería más próximo 1.1 que 0.7, de todas maneras el valor máximo de cobertura es 1.
Aprovecho para aclarar que las Familias están ordenadas, así no volverá a aparecer la familia 1 luego de la 5.
Saludos
roxana_
Perlero nuevo
Perlero nuevo
 
Mensajes: 14
Registrado: 2010-11-04 15:18 @679

Re: Recorrido comparando varias líneas entre sí

Notapor explorer » 2010-11-04 16:06 @712

Pero... aquí veo un problema...

Al leer la segunda línea, como es de la familia "1", debo compararla con la primera fila. Resulta que en la cobertura, el valor de la segunda es exactamente 1, PERO su resolución es peor (2,5 está más alejado del 0 que el 1,2 de la primera fila).

Hay que indicar si los criterios se deben aplicar a la vez, o en cascada (aplicar el criterio de resolución en caso de que coincida el valor de cobertura).
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

Re: Recorrido comparando varias líneas entre sí

Notapor roxana_ » 2010-11-04 16:13 @717

En cascada, es más importante la cobertura, en caso de que sea igual y como segundo criterio de selección comparar la resolución.
roxana_
Perlero nuevo
Perlero nuevo
 
Mensajes: 14
Registrado: 2010-11-04 15:18 @679

Re: Recorrido comparando varias líneas entre sí

Notapor explorer » 2010-11-04 18:15 @802

Bueno, pues este programa resuelve el tema pedido.
Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1. #!/usr/bin/perl
  2. use 5.010;
  3. use strict;
  4. use warnings;
  5. use diagnostics;
  6.  
  7. my $cabecera;   # guarda la línea de cabecera
  8. my %familias;   # guarda los registros más probables
  9.  
  10. while (<DATA>) {
  11.     #print;
  12.     chomp;
  13.  
  14.     if ($. == 1) {              # si es el primer registro, se trata de la cabecera
  15.         $cabecera = $_;         # la guardamos
  16.         next;                   # y saltamos a la siguiente línea
  17.     }
  18.  
  19.     # leemos los campos de la línea
  20.     #   0         1        2           3
  21.     my ($familia, $nombre, $cobertura, $resolucion) = split;
  22.  
  23.     # si no existe registro anterior
  24.     #   guardarlo
  25.     #   siguiente línea
  26.     if (!$familias{$familia}) {
  27.         $familias{$familia} = [ $familia, $nombre, $cobertura, $resolucion ];
  28.         next;
  29.     }
  30.  
  31.     # leemos el registro anterior
  32.     my ($cobertura_anterior, $resolucion_anterior) = @{$familias{$familia}}[2,3];
  33.  
  34.     #print "Comparando cobertura $cobertura_anterior : $cobertura\n";
  35.  
  36.     # si la cobertura es distinta de la anterior
  37.     #   si la cobertura es más cercana a 1
  38.     #           guardar registro
  39.     if ($cobertura != $cobertura_anterior) {
  40.         if (abs($cobertura - 1) < abs($cobertura_anterior - 1)) {
  41.             $familias{$familia} = [ $familia, $nombre, $cobertura, $resolucion ];
  42.         }
  43.     }
  44.    
  45.     # si las coberturas son iguales
  46.     #   si la resolución es más cercana a 0
  47.     #           guardar registro
  48.     else {
  49.         #print "Comparando resolucion $resolucion_anterior : $resolucion\n";
  50.         if (abs($resolucion - 0) < abs($resolucion_anterior - 0)) {
  51.             $familias{$familia} = [ $familia, $nombre, $cobertura, $resolucion ];
  52.         }
  53.     }
  54. }
  55.  
  56. # Impresión
  57. say $cabecera;
  58.  
  59. for my $familia (sort {$a <=> $b} keys %familias) {
  60.     say join qq[\t], @{$familias{$familia}};
  61. }
  62.  
  63. __DATA__
  64. Familia Nombre cobertura resolución
  65. 1         bovin       0.8         1.2
  66. 1         human       1           2.5
  67. 1         ecoli       1           2
  68. 2         ecoli       0.7         1.5
  69. 2         mouse       1           3
  70. 5         human       1           2.7
Coloreado en 0.003 segundos, usando GeSHi 1.0.8.4


Y esta es otra versión, más reducida:
Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1. #!/usr/bin/perl
  2. use 5.010;      
  3. use strict;    
  4. use warnings;  
  5. use diagnostics;
  6.  
  7. my $cabecera;                                   # guarda la línea de cabecera
  8. my %familias;                                   # guarda los registros más probables
  9. my ($cobertura_anterior, $resolucion_anterior); # datos del registro record de cada familia
  10.  
  11. $cabecera = <DATA>;
  12.  
  13. while (<DATA>) {
  14.     chomp;
  15.  
  16.     my ($familia, $nombre, $cobertura, $resolucion) = split;
  17.  
  18.     if (exists $familias{$familia}) {
  19.         ($cobertura_anterior, $resolucion_anterior) = @{$familias{$familia}}[2,3];
  20.     }  
  21.  
  22.     if (
  23.         ! exists($familias{$familia})
  24.     or
  25.         ($cobertura != $cobertura_anterior   and   abs($cobertura - 1) < abs($cobertura_anterior - 1))
  26.     or
  27.         ($cobertura == $cobertura_anterior   and   abs($resolucion   ) < abs($resolucion_anterior   ))
  28.     )
  29.     {
  30.         $familias{$familia} = [ $familia, $nombre, $cobertura, $resolucion ];
  31.     }
  32. }
  33.  
  34. # Impresión
  35. print $cabecera;
  36.  
  37. for my $familia (sort {$a <=> $b} keys %familias) {
  38.     say join qq[\t], @{$familias{$familia}};
  39. }
  40.  
  41. __DATA__
  42. Familia Nombre cobertura resolución  
  43. 1         bovin       0.8         1.2
  44. 1         human       1           2.5
  45. 1         ecoli       1           2  
  46. 2         ecoli       0.7         1.5
  47. 2         mouse       1           3  
  48. 5         human       1           2.7
Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4
El resultado es:
Sintáxis: [ Descargar ] [ Ocultar ]
Using text Syntax Highlighting
Familia Nombre cobertura resolución
1       ecoli   1       2
2       mouse   1       3
5       human   1       2.7
Coloreado en 0.000 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

Re: Recorrido comparando varias líneas entre sí

Notapor roxana_ » 2010-11-05 00:16 @053

Muchas gracias, me doy cuenta de lo mucho que me falta por aprender. Tengo una pregunta, ¿cómo puedo hacer para que los datos los tome directamente del archivo? Lo que sucede es que se trata de un archivo grande (más de 5000 líneas). Muchas gracias nuevamente.
roxana_
Perlero nuevo
Perlero nuevo
 
Mensajes: 14
Registrado: 2010-11-04 15:18 @679

Re: Recorrido comparando varias líneas entre sí

Notapor explorer » 2010-11-05 06:47 @324

Pues sencillo... solo tienes que abrir el fichero, leer línea a línea, y luego cerrarlo.

Del código anterior, solo tienes que cambiar las siguientes líneas:
Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1. open my $fichero, q[<], 'fichero-a-procesar' or die "ERROR: $!\n";
  2. while (<$fichero>) {
Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4
Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1. close $fichero;
Coloreado en 0.001 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

Re: Recorrido comparando varias líneas entre sí

Notapor roxana_ » 2010-11-08 12:33 @564

Traté de probar el script pero tengo otro problema: mi versión de Perl es v5.8.8 en Ubuntu 8.04 (Hardy Heron). Hasta donde sé muchos usuarios de Ubuntu tenemos problemas para pasar de la versión de Perl 5.8.8 a la 5.0.10. ¿Se podría adaptar este script para mi versión de Perl?
roxana_
Perlero nuevo
Perlero nuevo
 
Mensajes: 14
Registrado: 2010-11-04 15:18 @679

Re: Recorrido comparando varias líneas entre sí

Notapor explorer » 2010-11-08 12:48 @575

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


Volver a Básico

¿Quién está conectado?

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