jueves, 10 de noviembre de 2016

Programación del Sinclair QL (VII): Algoritmos de ordenación, planteamiento para las pruebas



Nota importante sobre los programas que se presenten

Incluiré el código completo del programa siempre al final de la entrada, pero a lo mejor veis que no coinciden los números de línea, e incluso que en la misma entrada los números de línea se solapan entre trozos del código.

Salvo en el módulo de carga en el resto del módulos no usan GOTO o GOSUB, aunque nunca es problema renumerarlos, ya que los números de línea solo sirven como referencia para la edición y los comentarios que haga, incluso puede que en algunos casos veáis que se solapan dentro del mismo articulo. Al final siempre encontrareis el código completo del mismo, podéis usarlo para vuestro QL o con vuestro emulador.

La base para las pruebas de algoritmos con datos en memoria


Empezaremos con lo básico para las pruebas de los algoritmos que es disponer de una estructura común para todos, que los llame con las mismas condiciones iniciales y guarde los resultados del proceso. En el QL hay un Reloj que podemos explotar bien desde código máquina, pero desde SuperBASIC solo tenemos posibilidad de contar segundos, es un poco limitado pero creo que bastará para las pruebas.

Voy a ordenar un arreglo de números de la longitud que le indiquemos, un procedimiento o función acepta un arreglo como parámetro de entrada, pero yo el arreglo no se lo puedo pasar al algoritmo como parámetro pues las variables se pasan por valor y lo que se ordenaría sería el arreglo copiado y no el original, es una limitación importante de no disponer de punteros.

El proceso lo voy a dividir en ficheros separados que cargaré usando MERGE, de esta forma es mas sencillo el mantenimiento, y tiene la ventaja de que cada módulo de ordenación es un fichero independiente, por lo que se puede usar en otros programas.

Módulo de carga


Este es el modulo que realizará la carga del resto, de forma que no hay que hacerlo manualmente nunca. Es muy sencillo pero hay que eliminarlo si se desea ejecutar el programa para que no lo vuelva a ejecutar, acuérdate de usar DLINE TO 999 cuando termine de cargar. Cada vez que incluyo un módulo debo cambiar la línea 170, y añadir dos líneas mas tras la 190 por cada módulo:

100 REMark ----------------------------------------
110 REMark -- ALGORITMOS DE ORDENACION --
120 REMark -- Modulo: Cargador de modulos --
130 REMark -- Autor.: javu61, noviembre 2016 --
140 REMark ----------------------------------------
150 :
160 :
170 DATA "mdv1_"
180 DATA "o_base" , "Modulo base"
190 DATA "o_selector" , "Modulo Selector"
200 DATA "o_burbuja" , "Modulo Burbuja"
210 DATA "o_sacudida" , "Modulo Sacudida"
220 DATA ""
230 :
240 actual = 0 : total = 0
250 DIM p$(20,2,20)
260 :
270 RESTORE 
280 READ u$
290 REPeat leer_data
300 READ p$(total,0) : IF p$(total,0)="" THEN EXIT leer_data
310 READ p$(total,1)
320 p$(total,0)=u$ & p$(total,0)
330 total=total+1
340 END REPeat leer_data
350 :
360 MODE 4 : PAPER 0 : CLS
370 PRINT "Cargando modulos del programa"
380 :
390 PRINT " (";actual;"/";total;") ";p$(actual,1)
400 MERGE p$(actual,0)
410 actual=actual+1
420 IF p$(actual,0) <> "" THEN GO TO 390
430 :
440 :
450 PRINT "Ejecute DLINE TO 999 antes de ejecutar"
460 STOP
En la línea 420 hay un GOTO, el único que encontrarás en el programa, está ya que al ejecutar la sentencia MERGE dentro de un bucle se pierden los punteros, hay que recurrir al método tradicional para que funcione.

Módulo base

Este es el modulo que realizará las pruebas de los algoritmos. Como veréis todo lo empiezo por una cabecera general con lo que es, no es necesario pero si una practica de buen programador. Una técnica para acelerar los programas en BASIC es eliminar comentarios, ya que el programa pasa por ellos y los debe analizar, esto no es necesario en SuperBASIC pues monta una tabla de procedimientos y funciones, por lo que casi nunca pasará por los comentarios.
1000 REMark ----------------------------------------
1010 REMark -- ALGORITMOS DE ORDENACION           --
1020 REMark --   Modulo: Base para las pruebas    --
1030 REMark --   Autor.: javu61, noviembre 2016   --
1040 REMark ----------------------------------------

Primero creo un manejador de errores, es una muy buena costumbre tener al menos una estándar, debe estar al principio para que el programa sepa que existe esa rutina de errores.

1060 REMark ----------------------------------------
1070 REMark -- Manejo de errores                  --
1080 REMark ----------------------------------------
1090 WHEN ERRor 
1100   PRINT "En la linea ";ERLIN;" se ha producido un error ";ERNUM;": ";
1110   REPORT #1,ERNUM
1120   STOP
1130 END WHEN 
 
Ahora voy lanzando procesos que hagan las cosas, contra mas modular mejor, pues es difícil seguir un programa largo y al dividirlo en partes pequeñas se simplifica su lectura, lo que para el mantenimiento es fundamental. Creo que fue Ole-Johan Dahl, uno de los creadores de la programación orientada a objetos, el que dijo que una función no debía ocupar mas de una página (supongo que de papel y no de pantalla). Empiezo borrando pantalla y pidiendo los elementos a ordenar, contra mas tenga mas tardará, y mejor resultado darán las prueba, pero el QL no es un veloz galgo, no os paséis.

1160 REMark ----------------------------------------
1170 REMark -- Pedir elementos a procesar         --
1180 REMark ----------------------------------------
1190 LET nroelem = 0    : REMark Nro elementos a ordenar
1200 :
1210 MODE 4 : PAPER 0 : CLS
1220 INPUT "Numero de elementos a ordenar: ";nroelem
1230 nroelem=nroelem - 1  : REMark Empieza en cero
 
A mi me gusta definir las variables siempre, ahorra errores, pero en SuperBASIC no es necesario ni posible mas que para los arreglos, pero lo simulo inicializándolas a un valor, y uso LET para distinguir que solo es la primera declaración. En SuperBASIC no existen las constates que hacen el código mas legible, las voy a simular con variables, todas son booleanas, en SuperBASIC cero equivale a falso y distinto de cero equivale a cierto.

1260 REMark ----------------------------------------
1270 REMark -- Definir Seudo-Contantes            --
1280 REMark ----------------------------------------
1290 LET No = 0          : REMark Valor para falso
1300 LET Si = 1          : REMark Valor para cierto
1310 LET Ascendente  = 0 : REMark Orden a montar
1320 LET Descendente = 1 : REMark Orden a montar
1330 :
1340 :
1350 REMark ----------------------------------------
1360 REMark -- Definir variables globales         --
1370 REMark ----------------------------------------
1380 LET m = 20         : REMark Nro maximo de rutinas a probar
1390 LET nrutina = 0    : REMark Algoritmo en prueba
1400 LET nropaso = 0    : REMark Paso en la prueba
1410 DIM nombres$(m,18) : REMark Nombres de algoritmos
1420 DIM tiempoi(m,3)   : REMark Guardar tiempos inicio
1430 DIM tiempof(m,3)   : REMark Guardar tiempos fin
1440 DIM nrocomp(m,3)   : REMark Numero de comparaciones
1450 DIM nromovi(m,3)   : REMark Numero de movimientos
1460 :
1470 DIM Abase(nroelem) : REMark Arreglo base aleatorio
1480 DIM Atemp(nroelem) : REMark Arreglo a ordenar
  
Solo queda ir llamando a los tres procesos que voy a utilizar, inicializar todo, llamar a la pruebas y presentar el resultado.

1510 REMark ----------------------------------------
1520 REMark -- Lanzar por procesos                --
1530 REMark ----------------------------------------
1540 Inicializar
1550 Probar
1560 INPUT "Finalizado",fin$
1570 Resultados
1580 STOP

El proceso de inicio crea un arreglo para los valores aleatorios y lo muestra en pantalla como referencia, para que veamos el origen.

1610 REMark ----------------------------------------
1620 REMark -- Inicializar                        --
1630 REMark ----------------------------------------
1640 DEFine PROCedure Inicializar
1650   Montar_arreglo Abase
1660   PRINT "----- Elementos a ordenar"
1670   Presentar_arreglo Abase
1680 END DEFine 
 
Paso al proceso que lanza las pruebas. En lenguajes que soporten punteros como el C o los orientados a objeto se puede crear un arreglo con los enlaces a las rutinas que definamos, no en SuperBASIC, por lo que empezamos un bucle indefinido, guiado por la variable nrutina en la que llevamos un contador de rutinas a probar, según el número seleccionamos el nombre del algoritmo o salimos del bucle. Luego hacemos tres pasadas por un bucle, la primera ordena el arreglo base aleatorio, la segunda con el mejor caso que es con el arreglo ya ordenado, y la tercera con el peor caso lo que invierte el arreglo completamente.

1710 REMark ----------------------------------------
1720 REMark -- Proceso de pruebas                 --
1730 REMark ----------------------------------------
1740 DEFine PROCedure Probar
1750   REPeat prueba_rutina
1760     Seleccion No
1770     IF nombres$(nrutina)="" THEN EXIT prueba_rutina
1780     PRINT "** Probando rutina ";nrutina;" ";nombres$(nrutina)
1790     :
1800     Copiar_arreglo Abase,Atemp
1810     FOR nropaso=0 TO 2
1820       IF nropaso <> 2 THEN 
1830         orden = Ascendente
1840       ELSE 
1850         orden = Descendente
1860       END IF 
1870       tiempoi(nrutina,nropaso)=DATE
1880       Seleccion Si,Atemp,orden
1890       tiempof(nrutina,nropaso)=DATE
1900       :
1910       Verifica_arreglo Atemp, orden
1920       :
1930       PRINT "-- ";nombres$(nrutina);
1940       SELect ON nropaso
1950         ON nropaso=0 : PRINT !" Aleatorio";
1960         ON nropaso=1 : PRINT !" Ordenado ";
1970         ON nropaso=2 : PRINT !" Inverso  ";
1980       END SELect 
1990       REMark PRINT !" (";DATE$;") "
2000       t=tiempof(nrutina,nropaso)-tiempoi(nrutina,nropaso)
2010       PRINT !"T: ";t;" seg";
2020       PRINT !"C: ";nrocomp(nrutina,nropaso);
2030       PRINT !"I: ";nromovi(nrutina,nropaso);
2040       PRINT
2050     END FOR nropaso
2060     :
2070     nrutina=nrutina+1
2080     IF nrutina > m THEN EXIT prueba_rutina
2090     :
2100   END REPeat prueba_rutina
2110 END DEFine 

Terminamos este grupo con la parte que presenta los resultados en la pantalla para poder compararlos todos entre sí. Para evitar líneas largas uso variables auxiliares con lo que mostrar.

2140 REMark ----------------------------------------
2150 REMark -- Presentar los resultados           --
2160 REMark ----------------------------------------
2170 DEFine PROCedure Resultados
2180   LOCal e1$,g1$,g2$
2190   :
2200   e1$=FILL$(" ",25)
2210   g1$=FILL$("-",24)
2220   g2$=FILL$("-",15)
2230   :
2240   CLS
2250   PRINT e1$;"+";g2$;"+";g2$;"+";g2$;"+"
2260   PRINT "       Con "; : Pnumero nroelem+1,3: PRINT " elementos";
2270   PRINT " |  Caso medio   |  Caso mejor   |   Caso peor   |"
2280   PRINT "+";g1$;"+";g2$;"+";g2$;"+";g2$;"+"
2290   FOR i=0 TO DIMN(nombres$)
2300     IF nombres$(i)="" THEN EXIT i
2310     t0=tiempof(i,0)-tiempoi(i,0)
2320     t1=tiempof(i,1)-tiempoi(i,1)
2330     t2=tiempof(i,2)-tiempoi(i,2)
2340     PRINT "| "; : Pnumero i,2
2350     PRINT " "; : PRINT nombres$(i);
2360     lon = 19-LEN(nombres$(i))
2370     IF lon > 0 THEN PRINT FILL$(" ",lon);
2380     PRINT " | "; : Pnumero t0,3
2390     PRINT " "; : Pnumero nrocomp(i,0),4
2400     PRINT " "; : Pnumero nromovi(i,0),4
2410     PRINT " | "; : Pnumero t1,3
2420     PRINT " "; : Pnumero nrocomp(i,1),4
2430     PRINT " "; : Pnumero nromovi(i,1),4
2440     PRINT " | "; : Pnumero t2,3
2450     PRINT " "; : Pnumero nrocomp(i,2),4
2460     PRINT " "; : Pnumero nromovi(i,2),4
2470     PRINT " |"
2480   END FOR i
2490   PRINT "+";g1$;"+";g2$;"+";g2$;"+";g2$;"+"
2500 END DEFine 
 
Luego tenemos rutinas auxiliares, la primera rellena un arreglo de un tamaño dado con valores aleatorios entre 10 y 99, de esta forma con un PRINT salen en columnas homogéneas.

2530 REMark ----------------------------------------
2540 REMark -- Rellena un arreglo con numeros     --
2550 REMark -- aleatorios de dos cifras           --
2560 REMark ----------------------------------------
2570 DEFine PROCedure Montar_arreglo(arreglo)
2580   LOCal i
2590   :
2600   FOR i=0 TO DIMN(arreglo)
2610     arreglo(i)=RND(10 TO 99)
2620   END FOR i
2630 END DEFine 
 
La segunda copia un arreglo sobre otro, es muy sencilla.

2660 REMark ----------------------------------------
2670 REMark -- Copiar un arreglo sobre otro       --
2680 REMark ----------------------------------------
2690 DEFine PROCedure Copiar_arreglo(origen,destino)
2700   LOCal i
2710   :
2720   IF DIMN(destino) < DIMN(origen) THEN 
2730     PRINT "ERROR copiando arreglo: Destino menor que origen"
2740     STOP
2750   END IF 
2760   :
2770   FOR i=0 TO DIMN(origen)
2780     destino(i)=origen(i)
2790   END FOR i
2800 END DEFine 

Luego otra para presentar por pantalla un arreglo, como todos los valores son de 2 cifras, mas el espacio intermedio, caben 25 valores por línea en modo 4.

2830 REMark ----------------------------------------
2840 REMark -- Presenta en pantalla un arreglo    --
2850 REMark ----------------------------------------
2860 DEFine PROCedure Presentar_arreglo(arreglo)
2870   LOCal i
2880   :
2890   FOR i=0 TO DIMN(arreglo)
2900     PRINT !arreglo(i);
2910   END FOR i
2920   PRINT
2930 END DEFine 
 
Para poder asegurarme de que las rutinas funciona bien, este proceso verifica que están bien ordenados los elementos del arreglo según el orden indicado.

2960 REMark ----------------------------------------
2970 REMark -- Ver si el arreglo esta ordenado    --
2980 REMark ----------------------------------------
2990 DEFine PROCedure Verifica_arreglo(arreglo, orden)
3000   LOCal i,hayerror
3010   :
3020   hayerror = No
3030   FOR i=0 TO DIMN(arreglo) - 1
3040     IF orden = Ascendente THEN 
3050       IF arreglo(i) > arreglo(i+1) THEN hayerror=Si
3060     ELSE 
3070       IF arreglo(i) < arreglo(i+1) THEN hayerror=Si
3080     END IF 
3090     IF hayerror THEN 
3100       PRINT "ERROR: Mal en orden";
3110       SELect ON orden
3120         = Ascendente  : PRINT !"ascendente";
3130         = Descendente : PRINT !"descendente";
3140       END SELect 
3150       PRINT !"Posicion ";i;"(";arreglo(i);")";
3160       PRINT !"Posicion ";i+1;"(";arreglo(i+1);")"
3170       Presentar_arreglo arreglo
3180       STOP
3190     END IF 
3200   END FOR i
3210 END DEFine   

Esta toma un número cualquiera y lo presenta relleno a ceros por la izquierda si es de menos de tres dígitos. Es sencillo ampliarla para que acepte como parámetro la longitud a rellenar.

3240 REMark ----------------------------------------
3250 REMark -- Presenta en pantalla un numero     --
3260 REMark ----------------------------------------
3270 DEFine PROCedure Pnumero(valor$,long)
3280   LOCal lon,aux$
3290   aux$=valor$
3300   IF aux$="" THEN aux$="0"
3310   lon = long - LEN(valor$)
3320   IF lon > 0 THEN aux$=FILL$(" ",lon) & aux$
3330   PRINT aux$;
3340 END DEFine 

Aquí terminan las rutinas de módulo base.

Módulo Selector

Este módulo contiene el procedimiento que llama al algoritmo en función del número, si no procesa monta la tabla de nombres de algoritmos, seguido por la línea que llama al algoritmo real. Hay que ir ampliándolo con los algoritmos que se desarrollen:

3500 REMark ----------------------------------------
3510 REMark -- ALGORITMOS DE ORDENACION           --
3520 REMark --   Modulo: Selector de algoritmos   --
3530 REMark --   Autor.: javu61, noviembre 2016   --
3540 REMark ----------------------------------------
3550 :
3560 :
3570 REMark ----------------------------------------
3580 REMark -- SELECCION DEL ALGORITMO            --
3590 REMark ----------------------------------------
3600 DEFine PROCedure Seleccion(procesar,arreglo,ordenacion)
3610   SELect ON nrutina
3620     ON nrutina=0
3630       nombres$(nrutina)="Burbuja"
3640       IF procesar THEN Burbuja arreglo,ordenacion,0,0
3650     ON nrutina=1
3660       nombres$(nrutina)="Burbuja Bidireccional"
3670       IF procesar THEN Sacudida arreglo,ordenacion,0,0
3680     :
3690     : REMark Aqui el resto de rutinas
3700     :
3710   END SELect 
3720 END DEFine 
 

Módulos de ordenación


Y por fin tenemos los métodos de ordenación, pongo la base de los dos primeros, la ordenación por burbuja y la ordenación por sacudida, solo para que el programa pueda ejecutarse y podemos ver cosas en pantalla. 

Modulo burbuja

4000 REMark ---------------------------------------------
4010 REMark -- ALGORITMOS DE ORDENACION                --
4020 REMark --   Modulo....: Burbuja                   --
4030 REMark --   Objetivo..: Ordena un arreglo por el  --
4040 REMark --               algoritmo de burbuja      --
4050 REMark --   Autor.....: javu61, 11/2016           --
4060 REMark --   Parametros:                           --
4070 REMark --     arreglo -> Arreglo a ordenar        --
4080 REMark --     sentido -> FALSO = Ascendente       --
4090 REMark --     primero -> primer elemento          --
4100 REMark --     ultimo  -> ultimo elemento          --
4110 REMark --                Si ultimo=0 -> Todos     --
4120 REMark ---------------------------------------------
4130 DEFine PROCedure Burbuja (arreglo,sentido,primero,ultimo)
4140   REMark Aqui va el codigo
4150 END DEFine 

Modulo sacudida

4500 REMark ---------------------------------------------
4510 REMark -- ALGORITMOS DE ORDENACION                --
4520 REMark --   Modulo....: Sacudida                  --
4530 REMark --   Objetivo..: Ordena un arreglo por el  --
4540 REMark --               algoritmo de burbuja      --
4550 REMark --               doble o sacudida          --
4560 REMark --   Autor.....: javu61, 11/2016           --
4570 REMark --   Parametros:                           --
4580 REMark --     arreglo -> Arreglo a ordenar        --
4590 REMark --     sentido -> FALSO = Ascendente       --
4600 REMark --     primero -> primer elemento          --
4610 REMark --     ultimo  -> ultimo elemento          --
4620 REMark --                Si ultimo=0 -> Todos     --
4630 REMark ---------------------------------------------
4640 DEFine PROCedure Sacudida (arreglo,sentido,primero,ultimo)
4650   REMark Aqui va el codigo
4660 END DEFine 


A partir de ahora solo presentaré los algoritmos que desarrolle en el QL, se añaden al final de todo, junto a código para manejarlos en el procedimiento anterior.

Podéis descargar el programa completo desde aquí, abrir los programas con un editor de textos (no el notepad que solo soporta textos con CR+LF) o cargarlo en un QL real o emulado.

3 comentarios:

  1. Este video de TED da una idea muy buena de cómo funcionan los distintos algoritmos de ordenación, para quienes no tengan conocimientos de este tema:

    http://ed.ted.com/lessons/what-s-the-fastest-way-to-alphabetize-your-bookshelf-chand-john

    Saludos,

    Badaman

    ResponderEliminar
  2. Estaría bien corregir en los fuentes el tema de la codificación HTML de los signos > y &. Las siguientes líneas fallan en SuperBasic por ese motivo.

    2080 IF nrutina &gt; m THEN EXIT prueba_rutina
    2370 IF lon &gt; 0 THEN PRINT FILL$(" ",lon);
    3320 IF lon &gt; 0 THEN aux$=FILL$(" ",lon) &amp; aux$

    El mismo problema está en algunos comentarios (REMark) del código, aunque eso no influye en la ejecución.


    Saludos.
    afx


    PD:
    Me gusta este planteamiento de este módulo para las pruebas.

    ResponderEliminar
    Respuestas
    1. Por eso pongo los fuentes en desacarga, así no hay problemas con el HTML

      Eliminar