Foro - Perl en Español

La comunidad de programadores en Perl de habla hispana.

Obviar


  • Publicidad

Arrays y subrutinas

¿Ya sabes lo que es una referencia? Has progresado, el nível básico es cosa del pasado y ahora estás listo para el siguiente nivel.
Publicar una respuesta

Arrays y subrutinas

Notapor Camino00 » 2019-05-13 11:05 @503

Buenas tardes, os pongo en situación:

Una compañera y yo estamos creando un programa para un trabajo de informática y hay una parte del código que no funciona correctamente. Estamos bastante desesperadas así que ojalá que alguien nos pueda ayudar :cry:

Lo que trata de hacer el programa es comparar los síntomas de una ficha médica (3 fichas, porque tenemos 3 pacientes) de un paciente con una ficha global que contiene enfermedades, síntomas y tratamientos. Si los síntomas coinciden, se debería imprimir la enfermedad correspondiente a esos síntomas.

Y ahí esta el problema: Los síntomas de un paciente están en un @array y cada enfermedad con sus síntomas y tratamientos dentro de la ficha global en un hash. En ese hash introducimos en un @array los valores correspondientes a la clave síntomas. Ese @array lo comparamos con el @array de síntomas del paciente. Lo que ocurre es que imprime muchas veces los mismo: la enfermedad, el gen...
Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1. foreach $s (@sintomas) {
  2.     foreach $v1 (@valor1) {
  3.         if ( $sintomas[$s] eq $valor1[$v1] ) {
  4.             foreach $clave1 ( keys(%E1) ) {
  5.                 if ( $clave1 =~ /^Enfermedad/ ) {
  6.                     print "Posible enfermedad: $E1{$clave1}\n";
  7.                 }
  8.                 elsif ( $clave1 =~ /^Gen/ ) {
  9.                     print "Esta enfermedad se expresa en el gen: $E1{$clave1}\n";
  10.                     $genm = "$E1{$clave1}";
  11.                 }
  12.             }
  13.  
  14.             sub compare {
  15.                 if ( $clave1 =~ /^Tratamiento/ ) {
  16.                     print "Tratamiento:\n\n";
  17.                     @valor11 = split( /;/, $E1{$clave1} );
  18.                     foreach $v1 (@valor11) {
  19.                         print "*$v1\n";
  20.                     }
  21.                 }
  22.             }
  23.         }
  24.     }
  25. }
Coloreado en 0.002 segundos, usando GeSHi 1.0.8.4


La siguiente duda es acerca de subrutinas.

Esta se declara en cada uno de los if() en los que comparamos los síntomas del paciente con los síntomas dentro del @array dentro del %hash de cada enfermedad. La subrutina se llama al final del programa con el fin de que tras una serie de comparaciones si el paciente verdaderamente tiene la enfermedad se impriman sus tratamientos.

Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1. if ( @dna_paciente eq @biochipc ) {
  2.     print "Analisis positivo, el paciente esta enfermo\n\n";
  3.     compare();
  4. }
  5. else {
  6.     print "Analisis negativo, el paciente no padece la enfermedad";
  7. }
Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4


Solo imprime los tratamientos de la última enfermedad (adjuntamos archivo enfermedades globales) porque es la última vez que se declara la subrutina.
Adjuntos
ENFERMEDADES.txt
(1.52 KiB) 187 veces
Camino00
Perlero nuevo
Perlero nuevo
 
Mensajes: 1
Registrado: 2019-05-13 10:39 @485
Arriba

Publicidad

Re: Arrays y subrutinas

Notapor explorer » 2019-05-13 15:39 @693

El primer problema (buscar la enfermedad y el gen asociado a un síntoma) os falta algo esencial: buscarlo.

En las líneas 6 y 9, lo único que hacéis es imprimir el valor de enfermedad y gen... para todas las claves del hash %E (así está indicado en la línea 4). Pero... no hacéis la prueba de si esa enfermedad corresponde con el $sintomas[$s] encontrado en la línea 3. En definitiva... pinta todas las enfermedades y genes.

La clave para resolver es: a partir de la línea 3, ¿cómo relacionamos el síntoma encontrado con su correspondiente enfermedad/gen?

Un detalle interesante... no sabemos qué contiene @valor1. Si hacemos caso a lo que dice la línea 3, contiene números enteros, ya que se están usando como índices del array @valor1.

Aquí hay una posible solución:
Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1. #!/usr/bin/env perl
  2. use v5.26;                              # queremos características modernas
  3. use utf8;                               # el código contiene caracteres en utf8
  4. use open IO => qw':utf8 :std';          # las entradas y salidas en UTF8. También las E/S estándar
  5. use autodie;                            # Es mejor morir que regresar con deshonor. --Proverbio Klingon
  6.  
  7. # Síntomas de prueba
  8. my @sintomas = ('Babeo excesivo', 'Congestion nasal', 'estrabismo');
  9.  
  10. # Todos los síntomas
  11. my @valor1;
  12.  
  13. # Leemos el archivo de enfermedades
  14. my %E1;
  15. open my $ENFERMEDADES, '<', 'ENFERMEDADES.txt';
  16. while (<$ENFERMEDADES>) {
  17.     #chomp;                                     # quitamos retorno de carro
  18.     s/[\r\n]+$//;                               # quitamos retorno de carro (versión para todas los sistemas)
  19.     my($clave, $valor) = /^(\w+):\s*(.+)/;      # separamos en dos campos
  20.  
  21.     $E1{$clave} = $valor;
  22.  
  23.     if ($clave =~ /^Sintomas/) {
  24.         my @s = split /[;]/, $valor;
  25.         push @valor1, @s;
  26.     }
  27. }
  28. close $ENFERMEDADES;
  29.  
  30.  
  31. foreach my $s (@sintomas) {                                     # Para todos los síntomas de los pacientes
  32.     say "Síntoma: $s";
  33.  
  34.     foreach my $v1 (@valor1) {                                  # Para todos los síntomas de enfermedades
  35.         if ( $s eq $v1 ) {                                      # Si el síntoma del paciente está registrada...
  36.  
  37.             foreach my $clave ( keys(%E1) ) {                   # Buscamos la enfermedad y el gen
  38.  
  39.                 if ( $clave =~ /^Sintomas(\d+)/ ) {             # Si son síntomas...
  40.                     if (index($E1{$clave}, $s) != -1) {         # y entre ellos está el que buscamos...
  41.                         my $i = $1;                             # nos quedamos con el número que sigue a "Sintomas"
  42.  
  43.                         say "Posible enfermedad: $E1{'Enfermedad' . $i}";
  44.                         say "Esta enfermedad se expresa en el gen: $E1{'Gen' . $i}";
  45.                     }
  46.                 }
  47.             }
  48.         }
  49.     }
  50. }
Coloreado en 0.002 segundos, usando GeSHi 1.0.8.4
La salida de este programa es:
Sintáxis: [ Descargar ] [ Ocultar ]
Using text Syntax Highlighting
Síntoma: Babeo excesivo
Posible enfermedad: Sindrome de Moebius
Esta enfermedad se expresa en el gen: PLXND1
Síntoma: Congestion nasal
Posible enfermedad: Fibrosis quistica
Esta enfermedad se expresa en el gen: CFTR
Síntoma: estrabismo
Posible enfermedad: Sindrome de Moebius
Esta enfermedad se expresa en el gen: PLXND1
Coloreado en 0.000 segundos, usando GeSHi 1.0.8.4

El truco está en usar el número que sigue a las palabras "Enfermedad", "Sintomas", "Gen". Pintar el tratamiento se haría de la misma manera.

Es un error definir la subrutina de esa manera... estáis redefiniéndola en cada paso del bucle foreach(). Lo mejor es pasar argumentos y leerlos en la subrutina y hacer operaciones con ellos.
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: Arrays y subrutinas

Notapor explorer » 2019-05-13 16:35 @733

Esta es otra solución. Parece que tiene un preámbulo muy largo, pero es para preparar toda la información, para que luego el problema se resuelva en muy pocas líneas.
Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1. #!/usr/bin/env perl
  2. use v5.26;                              # queremos características modernas
  3. use utf8;                               # el código contiene caracteres en utf8
  4. use open IO => qw':utf8 :std';          # las entradas y salidas en UTF8. También las E/S estándar
  5. use autodie;                            # Es mejor morir que regresar con deshonor. --Proverbio Klingon
  6.  
  7. # Síntomas de prueba
  8. my @sintomas = ('Babeo excesivo', 'Congestion nasal', 'un bulto nuevo en la mama o la axila');
  9.  
  10.  
  11. # Aquí almacenamos la información relativa a cada enfermedad
  12. my %ENFERMEDADES;
  13.  
  14. # Aquí almacenamos la información de la enfermedad correspondiente a cada síntoma
  15. my %ENFERMEDADES_para_este_;#síntoma
  16.  
  17.  
  18. # Leemos el archivo de enfermedades
  19. # Suponemos que el formato del archivo siempre va en este orden:
  20.  
  21. # Enfermedad1: <enfermedad1>
  22. # Gen1:        <gen1>
  23. # Sintomas1:   <sintomas1>
  24. # Tratamiento1:<tratamiento1>
  25. # ...
  26. #
  27.  
  28. open my $ENFERMEDADES, '<', 'ENFERMEDADES.txt';
  29. my $enfermedad;                                 # variable externa al while, para recordar qué enfermedad estamos leyendo
  30.  
  31. while (<$ENFERMEDADES>) {
  32.     #chomp;                                     # quitamos retorno de carro para el sistema en que estemos
  33.     s/[\r\n]+$//;                               # quitamos retorno de carro (versión para todas los sistemas)
  34.  
  35.     my($clave, $valor) = /^(\w+):\s*(.+)/;      # separamos en dos campos
  36.  
  37.     if ($clave =~ /^Enfermedad/) {
  38.         $enfermedad = $valor;
  39.        
  40.         $ENFERMEDADES{$enfermedad}{'nombre'} = $enfermedad;     # creamos una entrada en el hash de %ENFERMEDADES
  41.  
  42.         next;
  43.     }
  44.  
  45.     if ($clave =~ /Gen/) {
  46.         $ENFERMEDADES{$enfermedad}{'gen'} = $valor;             # creamos la entrada para el gen
  47.  
  48.         next;
  49.     }
  50.  
  51.     if ($clave =~ /Tratamiento/) {
  52.         my @tratamientos = split /[;]/, $valor;
  53.  
  54.         $ENFERMEDADES{$enfermedad}{'tratamiento'} = [@tratamientos];    # creamos la entrada para los tratamientos
  55.  
  56.         next;
  57.     }
  58.  
  59.     if ($clave =~ /Sintomas/) {
  60.         my @sintomas = split /[;]/, $valor;
  61.  
  62.         $ENFERMEDADES{$enfermedad}{'sintomas'} = [ @sintomas ]; # creamos la entrada para síntomas, en forma de array
  63.  
  64.         for my $sintoma (@sintomas) {                                   # para cada síntoma...
  65.             push @{$ENFERMEDADES_para_este_{$sintoma}}, $enfermedad;    # le relacionamos con su enfermedad
  66.             # (un síntoma puede estar en más de una enfermedad. Por eso lo guardamos como un array)
  67.         }
  68.  
  69.         next;
  70.     }
  71.  
  72. }
  73. close $ENFERMEDADES;
  74.  
  75. #use Data::Dumper;
  76. #say Dumper \%ENFERMEDADES;
  77. #say Dumper \%ENFERMEDADES_para_este_;
  78.  
  79. for my $sintoma (@sintomas) {                                   # Para todos los síntomas de los pacientes
  80.     say "Síntoma: $sintoma";
  81.  
  82.     if (not exists $ENFERMEDADES_para_este_{$sintoma}) {
  83.         say "ERROR: No tengo catalogado ese síntoma";
  84.     }
  85.  
  86.     for my $enfermedad ( @{$ENFERMEDADES_para_este_{$sintoma} } ) {     # Para todas las enfermedades que tienen ese síntoma
  87.  
  88.         say "Posible enfermedad: $ENFERMEDADES{$enfermedad}{'nombre'}";
  89.         say "Esta enfermedad se expresa en el gen: $ENFERMEDADES{$enfermedad}{'gen'}";
  90.         say "Tratamiento:";
  91.  
  92.         for my $tratamiento (@{$ENFERMEDADES{$enfermedad}{'tratamiento'}}) {
  93.             say "\t$tratamiento";
  94.         }
  95.     }
  96.  
  97.     say "";
  98. }
Coloreado en 0.003 segundos, usando GeSHi 1.0.8.4
La salida es:
Sintáxis: [ Descargar ] [ Ocultar ]
Using text Syntax Highlighting
Síntoma: Babeo excesivo
Posible enfermedad: Sindrome de Moebius
Esta enfermedad se expresa en el gen: PLXND1
Tratamiento:
        Sin tratamiento

Síntoma: Congestion nasal
Posible enfermedad: Fibrosis quistica
Esta enfermedad se expresa en el gen: CFTR
Tratamiento:
        Sin tratamiento

Síntoma: un bulto nuevo en la mama o la axila
Posible enfermedad: Cancer de mama
Esta enfermedad se expresa en el gen: BRCA1
Tratamiento:
        Quimioterapia
        lumpectomia
        mastectomia
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
Arriba
Publicar una respuesta

Volver a Intermedio

¿Quién está conectado?

Usuarios navegando por este Foro: No hay usuarios registrados visitando el Foro y 2 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
cron