--- /dev/null
+\r
+INFORME: Generado 90% Creciente y 10% Desordenado. Ordenado de forma Creciente.\r
+======= ~~~~~~~~ ~~~ ~~~~~~~~~ ~ ~~~ ~~~~~~~~~~~~ ~~~~~~~~ ~~ ~~~~~ ~~~~~~~~~~\r
+\r
+\r
+Bubble Sort:\r
+ Comparaciones: 998001\r
+ Intercambios: 49214 (147642 asignaciones)\r
+ Tiempo (seg): 85.30\r
+\r
+Bubble Sort Mejorado:\r
+ Comparaciones: 95849\r
+ Intercambios: 49214 (147642 asignaciones)\r
+ Tiempo (seg): 18.12\r
+\r
+Shake Sort:\r
+ Comparaciones: 94733\r
+ Intercambios: 49214 (147642 asignaciones)\r
+ Tiempo (seg): 18.07\r
+\r
+Ripple Sort:\r
+ Comparaciones: 499500\r
+ Intercambios: 49214 (147642 asignaciones)\r
+ Tiempo (seg): 48.12\r
+\r
+Selection Sort:\r
+ Comparaciones: 499500\r
+ Intercambios: 992 (2976 asignaciones)\r
+ Tiempo (seg): 37.18\r
+\r
+Insertion Sort::\r
+ Comparaciones: 50213\r
+ Intercambios: 16737 (50213 asignaciones)\r
+ Tiempo (seg): 7.53\r
+\r
+Shell's Sort::\r
+ Comparaciones: 34808\r
+ Intercambios: 4170 (12510 asignaciones)\r
+ Tiempo (seg): 3.57\r
+\r
+Shell's Sort Mejorado:\r
+ Comparaciones: 12086\r
+ Intercambios: 4170 (12510 asignaciones)\r
+ Tiempo (seg): 1.75\r
+\r
+Quick Sort:\r
+ Comparaciones: 11268\r
+ Intercambios: 1736 (5208 asignaciones)\r
+ Tiempo (seg): 1.27\r
+\r
+\r
+NOTA: La cantidad de intercambios medida se tom¢ a partir de la cantidad de\r
+==== asignaciones, ya que en el Insertion Sort no hay intercambios. De esta\r
+ manera, un intercambio equivales a 3 asignaciones.
\ No newline at end of file
--- /dev/null
+\r
+INFORME: Generado 90% Creciente y 10% Desordenado. Ordenado de forma Dereciente.\r
+======= ~~~~~~~~ ~~~ ~~~~~~~~~ ~ ~~~ ~~~~~~~~~~~~ ~~~~~~~~ ~~ ~~~~~ ~~~~~~~~~~\r
+\r
+\r
+Bubble Sort:\r
+ Comparaciones: 998001\r
+ Intercambios: 450286 (1350858 asignaciones)\r
+ Tiempo (seg): 174.01\r
+\r
+Bubble Sort Mejorado:\r
+ Comparaciones: 499500\r
+ Intercambios: 450286 (1350858 asignaciones)\r
+ Tiempo (seg): 136.82\r
+\r
+Shake Sort:\r
+ Comparaciones: 471163\r
+ Intercambios: 450285 (1350855 asignaciones)\r
+ Tiempo (seg): 134.78\r
+\r
+Ripple Sort:\r
+ Comparaciones: 499500\r
+ Intercambios: 450286 (1350858 asignaciones)\r
+ Tiempo (seg): 136.82\r
+\r
+Selection Sort:\r
+ Comparaciones: 499500\r
+ Intercambios: 980 (2940 asignaciones)\r
+ Tiempo (seg): 37.08\r
+\r
+Insertion Sort:\r
+ Comparaciones: 450386\r
+ Intercambios: 150428 (451285 asignaciones)\r
+ Tiempo (seg): 66.90\r
+\r
+Shell's Sort:\r
+ Comparaciones: 40717\r
+ Intercambios: 5182 (15546 asignaciones)\r
+ Tiempo (seg): 4.17\r
+\r
+Shell's Sort Mejorado:\r
+ Comparaciones: 12483\r
+ Intercambios: 5182 (15546 asignaciones)\r
+ Tiempo (seg): 2.09\r
+\r
+Quick Sort:\r
+ Comparaciones: 11134\r
+ Intercambios: 1972 (5916 asignaciones)\r
+ Tiempo (seg): 1.26\r
+\r
+\r
+NOTA: La cantidad de intercambios medida se tom¢ a partir de la cantidad de\r
+==== asignaciones, ya que en el Insertion Sort no hay intercambios. De esta\r
+ manera, un intercambio equivales a 3 asignaciones.
\ No newline at end of file
--- /dev/null
+\r
+INFORME: Generado 90% Dereciente y 10% Desordenado. Ordenado de forma Creciente.\r
+======= ~~~~~~~~ ~~~ ~~~~~~~~~~ ~ ~~~ ~~~~~~~~~~~~ ~~~~~~~~ ~~ ~~~~~ ~~~~~~~~~~\r
+\r
+\r
+Bubble Sort:\r
+ Comparaciones: 998001\r
+ Intercambios: 457205 (1371615 asignaciones)\r
+ Tiempo (seg): 174.39\r
+\r
+Bubble Sort Mejorado:\r
+ Comparaciones: 499500\r
+ Intercambios: 457205 (1371615 asignaciones)\r
+ Tiempo (seg): 138.35\r
+\r
+Shake Sort:\r
+ Comparaciones: 481087\r
+ Intercambios: 457204 (1371612 asignaciones)\r
+ Tiempo (seg): 137.32\r
+\r
+Ripple Sort:\r
+ Comparaciones: 499500\r
+ Intercambios: 457205 (1371615 asignaciones)\r
+ Tiempo (seg): 138.47\r
+\r
+Selection Sort:\r
+ Comparaciones: 499500\r
+ Intercambios: 985 (2955 asignaciones)\r
+ Tiempo (seg): 37.07\r
+\r
+Insertion Sort:\r
+ Comparaciones: 457305\r
+ Intercambios: 152734 (458204 asignaciones)\r
+ Tiempo (seg): 67.56\r
+\r
+Shell's Sort:\r
+ Comparaciones: 36788\r
+ Intercambios: 5081 (15243 asignaciones)\r
+ Tiempo (seg): 3.90\r
+\r
+Shell's Sort Mejorado:\r
+ Comparaciones: 12359\r
+ Intercambios: 5081 (15243 asignaciones)\r
+ Tiempo (seg): 2.03\r
+\r
+Quick Sort:\r
+ Comparaciones: 11096\r
+ Intercambios: 1995 (5985 asignaciones)\r
+ Tiempo (seg): 1.26\r
+\r
+\r
+NOTA: La cantidad de intercambios medida se tom¢ a partir de la cantidad de\r
+==== asignaciones, ya que en el Insertion Sort no hay intercambios. De esta\r
+ manera, un intercambio equivales a 3 asignaciones.
\ No newline at end of file
--- /dev/null
+\r
+INFORME: Generado 90% Decreciente y 10% Desordenado. Ordenado de forma Decreciente.\r
+======= ~~~~~~~~ ~~~ ~~~~~~~~~~~ ~ ~~~ ~~~~~~~~~~~~ ~~~~~~~~ ~~ ~~~~~ ~~~~~~~~~~~~\r
+\r
+\r
+Bubble Sort:\r
+ Comparaciones: 998001\r
+ Intercambios: 42295 (126885 asignaciones)\r
+ Tiempo (seg): 83.87\r
+\r
+Bubble Sort Mejorado:\r
+ Comparaciones: 95849\r
+ Intercambios: 42295 (126885 asignaciones)\r
+ Tiempo (seg): 16.53\r
+\r
+Shake Sort:\r
+ Comparaciones: 80303\r
+ Intercambios: 42295 (126885 asignaciones)\r
+ Tiempo (seg): 15.33\r
+\r
+Ripple Sort:\r
+ Comparaciones: 499500\r
+ Intercambios: 42295 (126885 asignaciones)\r
+ Tiempo (seg): 46.24\r
+\r
+Selection Sort:\r
+ Comparaciones: 499500\r
+ Intercambios: 965 (2895 asignaciones)\r
+ Tiempo (seg): 36.64\r
+\r
+Insertion Sort:\r
+ Comparaciones: 43294\r
+ Intercambios: 14431 (43294 asignaciones)\r
+ Tiempo (seg): 6.48\r
+\r
+Shell's Sort:\r
+ Comparaciones: 37789\r
+ Intercambios: 4387 (13161 asignaciones)\r
+ Tiempo (seg): 3.74\r
+\r
+Shell's Sort Mejorado:\r
+ Comparaciones: 12334\r
+ Intercambios: 4387 (13161 asignaciones)\r
+ Tiempo (seg): 1.92\r
+\r
+Quick Sort:\r
+ Comparaciones: 11108\r
+ Intercambios: 1673 (5019 asignaciones)\r
+ Tiempo (seg): 1.15\r
+\r
+\r
+NOTA: La cantidad de intercambios medida se tom¢ a partir de la cantidad de\r
+==== asignaciones, ya que en el Insertion Sort no hay intercambios. De esta\r
+ manera, un intercambio equivales a 3 asignaciones.
\ No newline at end of file
--- /dev/null
+\r
+INFORME: Generado de forma Creciente. Ordenado de forma Creciente.\r
+======= ~~~~~~~~ ~~ ~~~~~ ~~~~~~~~~~ ~~~~~~~~ ~~ ~~~~~ ~~~~~~~~~~\r
+\r
+\r
+Bubble Sort:\r
+ Comparaciones: 998001\r
+ Intercambios: 0 (0 asignaciones)\r
+ Tiempo (seg): 60.31\r
+\r
+Bubble Sort Mejorado:\r
+ Comparaciones: 999\r
+ Intercambios: 0 (0 asignaciones)\r
+ Tiempo (seg): 0.05\r
+\r
+Shake Sort:\r
+ Comparaciones: 999\r
+ Intercambios: 0 (0 asignaciones)\r
+ Tiempo (seg): 0.06\r
+\r
+Ripple Sort:\r
+ Comparaciones: 499500\r
+ Intercambios: 0 (0 asignaciones)\r
+ Tiempo (seg): 29.93\r
+\r
+Selection Sort:\r
+ Comparaciones: 499500\r
+ Intercambios: 0 (0 asignaciones)\r
+ Tiempo (seg): 30.10\r
+\r
+Insertion Sort:\r
+ Comparaciones: 999\r
+ Intercambios: 333 (999 asignaciones)\r
+ Tiempo (seg): 0.11\r
+\r
+Shell's Sort:\r
+ Comparaciones: 8006\r
+ Intercambios: 0 (0 asignaciones)\r
+ Tiempo (seg): 0.50\r
+\r
+Shell's Sort Mejorado:\r
+ Comparaciones: 8006\r
+ Intercambios: 0 (0 asignaciones)\r
+ Tiempo (seg): 0.49\r
+\r
+Quick Sort:\r
+ Comparaciones: 8010\r
+ Intercambios: 0 (0 asignaciones)\r
+ Tiempo (seg): 0.49\r
+\r
+\r
+NOTA: La cantidad de intercambios medida se tom¢ a partir de la cantidad de\r
+==== asignaciones, ya que en el Insertion Sort no hay intercambios. De esta\r
+ manera, un intercambio equivales a 3 asignaciones.
\ No newline at end of file
--- /dev/null
+\r
+INFORME: Generado de forma Creciente. Ordenado de forma Decreciente.\r
+======= ~~~~~~~~ ~~ ~~~~~ ~~~~~~~~~~ ~~~~~~~~ ~~ ~~~~~ ~~~~~~~~~~~~\r
+\r
+\r
+Bubble Sort:\r
+ Comparaciones: 998001\r
+ Intercambios: 499500 (1498500 asignaciones)\r
+ Tiempo (seg): 174.83\r
+\r
+Bubble Sort Mejorado:\r
+ Comparaciones: 499500\r
+ Intercambios: 499500 (1498500 asignaciones)\r
+ Tiempo (seg): 140.11\r
+\r
+Shake Sort:\r
+ Comparaciones: 499499\r
+ Intercambios: 499499 (1498497 asignaciones)\r
+ Tiempo (seg): 140.72\r
+\r
+Ripple Sort:\r
+ Comparaciones: 499500\r
+ Intercambios: 499500 (1498500 asignaciones)\r
+ Tiempo (seg): 140.72\r
+\r
+Selection Sort:\r
+ Comparaciones: 499500\r
+ Intercambios: 500 (1500 asignaciones)\r
+ Tiempo (seg): 35.37\r
+\r
+Insertion Sort:\r
+ Comparaciones: 499500\r
+ Intercambios: 166833 (500499 asignaciones)\r
+ Tiempo (seg): 70.47\r
+\r
+Shell's Sort:\r
+ Comparaciones: 18942\r
+ Intercambios: 4700 (14100 asignaciones)\r
+ Tiempo (seg): 2.37\r
+\r
+Shell's Sort Mejorado:\r
+ Comparaciones: 11716\r
+ Intercambios: 4700 (14100 asignaciones)\r
+ Tiempo (seg): 1.81\r
+\r
+Quick Sort:\r
+ Comparaciones: 8018\r
+ Intercambios: 500 (1500 asignaciones)\r
+ Tiempo (seg): 0.71\r
+\r
+\r
+NOTA: La cantidad de intercambios medida se tom¢ a partir de la cantidad de\r
+==== asignaciones, ya que en el Insertion Sort no hay intercambios. De esta\r
+ manera, un intercambio equivales a 3 asignaciones.
\ No newline at end of file
--- /dev/null
+\r
+INFORME: Generado de forma Decreciente. Ordenado de forma Creciente.\r
+======= ~~~~~~~~ ~~ ~~~~~ ~~~~~~~~~~~~ ~~~~~~~~ ~~ ~~~~~ ~~~~~~~~~~\r
+\r
+\r
+Bubble Sort:\r
+ Comparaciones: 998001\r
+ Intercambios: 499500 (1498500 asignaciones)\r
+ Tiempo (seg): 185.59\r
+\r
+Bubble Sort Mejorado:\r
+ Comparaciones: 499500\r
+ Intercambios: 499500 (1498500 asignaciones)\r
+ Tiempo (seg): 148.35\r
+\r
+Shake Sort:\r
+ Comparaciones: 499499\r
+ Intercambios: 499499 (1498497 asignaciones)\r
+ Tiempo (seg): 148.63\r
+\r
+Ripple Sort:\r
+ Comparaciones: 499500\r
+ Intercambios: 499500 (1498500 asignaciones)\r
+ Tiempo (seg): 147.75\r
+\r
+Selection Sort:\r
+ Comparaciones: 499500\r
+ Intercambios: 500 (1500 asignaciones)\r
+ Tiempo (seg): 37.08\r
+\r
+Insertion Sort:\r
+ Comparaciones: 499500\r
+ Intercambios: 166833 (500499 asignaciones)\r
+ Tiempo (seg): 73.82\r
+\r
+Shell's Sort:\r
+ Comparaciones: 18942\r
+ Intercambios: 4700 (14100 asignaciones)\r
+ Tiempo (seg): 2.41\r
+\r
+Shell's Sort Mejorado:\r
+ Comparaciones: 11716\r
+ Intercambios: 4700 (14100 asignaciones)\r
+ Tiempo (seg): 1.98\r
+\r
+Quick Sort:\r
+ Comparaciones: 8018\r
+ Intercambios: 500 (1500 asignaciones)\r
+ Tiempo (seg): 0.66\r
+\r
+\r
+NOTA: La cantidad de intercambios medida se tom¢ a partir de la cantidad de\r
+==== asignaciones, ya que en el Insertion Sort no hay intercambios. De esta\r
+ manera, un intercambio equivales a 3 asignaciones.
\ No newline at end of file
--- /dev/null
+\r
+INFORME: Generado de forma Decreciente. Ordenado de forma Decreciente.\r
+======= ~~~~~~~~ ~~ ~~~~~ ~~~~~~~~~~~~ ~~~~~~~~ ~~ ~~~~~ ~~~~~~~~~~~~\r
+\r
+\r
+Bubble Sort:\r
+ Comparaciones: 998001\r
+ Intercambios: 0 (0 asignaciones)\r
+ Tiempo (seg): 70.42\r
+\r
+Bubble Sort Mejorado:\r
+ Comparaciones: 999\r
+ Intercambios: 0 (0 asignaciones)\r
+ Tiempo (seg): 0.11\r
+\r
+Shake Sort:\r
+ Comparaciones: 999\r
+ Intercambios: 0 (0 asignaciones)\r
+ Tiempo (seg): 0.05\r
+\r
+Ripple Sort:\r
+ Comparaciones: 499500\r
+ Intercambios: 0 (0 asignaciones)\r
+ Tiempo (seg): 35.15\r
+\r
+Selection Sort:\r
+ Comparaciones: 499500\r
+ Intercambios: 0 (0 asignaciones)\r
+ Tiempo (seg): 34.66\r
+\r
+Insertion Sort:\r
+ Comparaciones: 999\r
+ Intercambios: 333 (999 asignaciones)\r
+ Tiempo (seg): 0.11\r
+\r
+Shell's Sort:\r
+ Comparaciones: 8006\r
+ Intercambios: 0 (0 asignaciones)\r
+ Tiempo (seg): 0.60\r
+\r
+Shell's Sort Mejorado:\r
+ Comparaciones: 8006\r
+ Intercambios: 0 (0 asignaciones)\r
+ Tiempo (seg): 0.55\r
+\r
+Quick Sort:\r
+ Comparaciones: 8010\r
+ Intercambios: 0 (0 asignaciones)\r
+ Tiempo (seg): 0.61\r
+\r
+\r
+NOTA: La cantidad de intercambios medida se tom¢ a partir de la cantidad de\r
+==== asignaciones, ya que en el Insertion Sort no hay intercambios. De esta\r
+ manera, un intercambio equivales a 3 asignaciones.
\ No newline at end of file
--- /dev/null
+\r
+INFORME: Generado Desordenado. Ordenado de forma Creciente.\r
+======= ~~~~~~~~ ~~~~~~~~~~~~ ~~~~~~~~ ~~ ~~~~~ ~~~~~~~~~~\r
+\r
+\r
+Bubble Sort:\r
+ Comparaciones: 998001\r
+ Intercambios: 242487 (727461 asignaciones)\r
+ Tiempo (seg): 128.08\r
+\r
+Bubble Sort Mejorado:\r
+ Comparaciones: 497085\r
+ Intercambios: 242487 (727461 asignaciones)\r
+ Tiempo (seg): 90.68\r
+\r
+Shake Sort:\r
+ Comparaciones: 327945\r
+ Intercambios: 242487 (727461 asignaciones)\r
+ Tiempo (seg): 77.89\r
+\r
+Ripple Sort:\r
+ Comparaciones: 499500\r
+ Intercambios: 242487 (727461 asignaciones)\r
+ Tiempo (seg): 90.79\r
+\r
+Selection Sort:\r
+ Comparaciones: 499500\r
+ Intercambios: 989 (2967 asignaciones)\r
+ Tiempo (seg): 37.30\r
+\r
+Insertion Sort:\r
+ Comparaciones: 243480\r
+ Intercambios: 81162 (243486 asignaciones)\r
+ Tiempo (seg): 36.08\r
+\r
+Shell's Sort:\r
+ Comparaciones: 54699\r
+ Intercambios: 7395 (22185 asignaciones)\r
+ Tiempo (seg): 5.71\r
+\r
+Shell's Sort Mejorado:\r
+ Comparaciones: 14892\r
+ Intercambios: 7395 (22185 asignaciones)\r
+ Tiempo (seg): 2.80\r
+\r
+Quick Sort:\r
+ Comparaciones: 10400\r
+ Intercambios: 2343 (7029 asignaciones)\r
+ Tiempo (seg): 1.32\r
+\r
+\r
+NOTA: La cantidad de intercambios medida se tom¢ a partir de la cantidad de\r
+==== asignaciones, ya que en el Insertion Sort no hay intercambios. De esta\r
+ manera, un intercambio equivales a 3 asignaciones.\r
--- /dev/null
+\r
+INFORME: Generado Desordenado. Ordenado de forma Decreciente.\r
+======= ~~~~~~~~ ~~~~~~~~~~~~ ~~~~~~~~ ~~ ~~~~~ ~~~~~~~~~~~~\r
+\r
+\r
+Bubble Sort:\r
+ Comparaciones: 998001\r
+ Intercambios: 257013 (771039 asignaciones)\r
+ Tiempo (seg): 130.50\r
+\r
+Bubble Sort Mejorado:\r
+ Comparaciones: 498275\r
+ Intercambios: 257013 (771039 asignaciones)\r
+ Tiempo (seg): 93.59\r
+\r
+Shake Sort:\r
+ Comparaciones: 350030\r
+ Intercambios: 257013 (771039 asignaciones)\r
+ Tiempo (seg): 83.21\r
+\r
+Ripple Sort:\r
+ Comparaciones: 499500\r
+ Intercambios: 257013 (771039 asignaciones)\r
+ Tiempo (seg): 93.65\r
+\r
+Selection Sort:\r
+ Comparaciones: 499500\r
+ Intercambios: 995 (2985 asignaciones)\r
+ Tiempo (seg): 36.80\r
+\r
+Insertion Sort:\r
+ Comparaciones: 258002\r
+ Intercambios: 86004 (258012 asignaciones)\r
+ Tiempo (seg): 37.85\r
+\r
+Shell's Sort:\r
+ Comparaciones: 53633\r
+ Intercambios: 7079 (21237 asignaciones)\r
+ Tiempo (seg): 5.54\r
+\r
+Shell's Sort Mejorado:\r
+ Comparaciones: 14566\r
+ Intercambios: 7079 (21237 asignaciones)\r
+ Tiempo (seg): 2.58\r
+\r
+Quick Sort:\r
+ Comparaciones: 11319\r
+ Intercambios: 2325 (6975 asignaciones)\r
+ Tiempo (seg): 1.38\r
+\r
+\r
+NOTA: La cantidad de intercambios medida se tom¢ a partir de la cantidad de\r
+==== asignaciones, ya que en el Insertion Sort no hay intercambios. De esta\r
+ manera, un intercambio equivales a 3 asignaciones.\r
--- /dev/null
+program Comparacion_De_Algoritmos_De_Ordenamiento;\r
+\r
+uses\r
+ CRT, DOS;\r
+\r
+const\r
+ MAX_APE = 15;\r
+ RETARDO = 50; { NUMERO DEFINITIVO: 50? }\r
+ VERSION = '1.2.4';\r
+\r
+type\r
+ APELLIDO = string[MAX_APE];\r
+ DOCUMENTO = longint;\r
+ PERSONA = record\r
+ ap: APELLIDO;\r
+ dni: DOCUMENTO;\r
+ end;\r
+ HORA = record\r
+ h,\r
+ m,\r
+ s,\r
+ c: longint;\r
+ end;\r
+ TABLA = array[1..1000] of PERSONA;\r
+ TIPO_LETRA = ( TL_VOCAL, TL_CONSO );\r
+ TIPO_VOCAL = ( TV_AEIOU, TV_EI );\r
+ INDICADOR = ( I_NADA, I_ESB, I_ESC, I_ESF, I_ESG, I_ESL, I_ESM, I_ESN, I_ESQ, I_ESQU, I_ESR, I_EST );\r
+\r
+(*********************************************************)\r
+\r
+ procedure CargarArchivo( var datos: TABLA; var ar: text; tam: integer );\r
+\r
+ var\r
+ i: integer;\r
+\r
+ begin\r
+ for i:= 1 to tam do\r
+ begin\r
+ writeln( ar, datos[i].ap );\r
+ writeln( ar, datos[i].dni );\r
+ writeln( ar );\r
+ end;\r
+ end;\r
+\r
+(*********************************************************)\r
+\r
+ procedure Retardar( centenas: longint );\r
+\r
+ var\r
+ i: integer;\r
+\r
+ begin\r
+ for i:= 1 to centenas * 100 do ;\r
+ end;\r
+\r
+(*********************************************************)\r
+(*********************************************************)\r
+\r
+ procedure MenuEvaluar( var datos: TABLA; var arch: text );\r
+\r
+ type\r
+ ORDEN = ( CRECIENTE, DECRECIENTE );\r
+ MEDICION = record\r
+ Comp,\r
+ Int,\r
+ Tiem: longint;\r
+ end;\r
+ var\r
+ bs, bsm, shs, rs, ss, is, sls, slsm, qs: MEDICION;\r
+\r
+ (*********************************************************)\r
+\r
+ procedure CrearInforme( ord: ORDEN );\r
+\r
+ (*********************************************************)\r
+\r
+ procedure InfMetodo( var info: text; metodo: string; sort: MEDICION );\r
+\r
+ begin\r
+ writeln( info );\r
+ writeln( info, metodo, ':' );\r
+ writeln( info, ' Comparaciones: ', sort.Comp: 1 );\r
+ writeln( info, ' Intercambios: ', sort.Int div 3: 1, ' (', sort.Int: 1, ' asignaciones)' );\r
+ writeln( info, ' Tiempo (seg): ', sort.Tiem / 100: 2: 2 );\r
+ end; { procedure InfMetodo }\r
+\r
+ (*********************************************************)\r
+\r
+ var { procedure CrearInforme }\r
+ info: text;\r
+\r
+ begin\r
+ assign( info, 'INFORME.TXT' );\r
+ rewrite( info );\r
+ writeln( info );\r
+ if ord = DECRECIENTE then\r
+ begin\r
+ writeln( info, 'INFORME: Orden Decreciente.' );\r
+ writeln( info, '======= ~~~~~ ~~~~~~~~~~~' );\r
+ end\r
+ else\r
+ begin\r
+ writeln( info, 'INFORME: Orden Creciente.' );\r
+ writeln( info, '======= ~~~~~ ~~~~~~~~~' );\r
+ end;\r
+ writeln( info );\r
+ InfMetodo( info, 'Bubble Sort:', bs );\r
+ InfMetodo( info, 'Bubble Sort Mejorado:', bsm );\r
+ InfMetodo( info, 'Shake Sort:', shs );\r
+ InfMetodo( info, 'Ripple Sort:', rs );\r
+ InfMetodo( info, 'Selection Sort:', ss );\r
+ InfMetodo( info, 'Insertion Sort:', is );\r
+ InfMetodo( info, 'Shell''s Sort:', sls );\r
+ InfMetodo( info, 'Shell''s Sort Mejorado:', slsm );\r
+ InfMetodo( info, 'Quick Sort:', qs );\r
+ writeln( info );\r
+ writeln( info );\r
+ writeln( info, 'NOTA: La cantidad de intercambios medida se tom¢ a partir de la cantidad de' );\r
+ writeln( info, '==== asignaciones, ya que en el Insertion Sort no hay intercambios. De esta' );\r
+ writeln( info, ' manera, un intercambio equivales a 3 asignaciones.' );\r
+ close( info );\r
+ end; { procedure CrearInforme }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure NoExisteArch;\r
+\r
+ begin\r
+ clrscr;\r
+ gotoxy( 20, 10 );\r
+ textcolor( LightMagenta + Blink );\r
+ writeln( 'ERROR: No existe el archivo a evaluar!' );\r
+ textcolor( LightGray );\r
+ writeln;\r
+ writeln( ' Creelo seleccionando la opci¢n 1 del Men£ Principal.' );\r
+ delay( 4000 );\r
+ end; { procedure NoExisteArch }\r
+\r
+ (*********************************************************)\r
+\r
+ function ExisteArchivo( nombre: String ): boolean;\r
+ { funcion extrido de la ayuda del pascal }\r
+ var\r
+ arch: text;\r
+\r
+ begin\r
+ {$I-}\r
+ Assign( arch, nombre );\r
+ FileMode := 0; { Solo lectura }\r
+ Reset( arch );\r
+ Close( arch );\r
+ {$I+}\r
+ ExisteArchivo := (IOResult = 0) and (nombre <> '');\r
+ end; { function ExisteArchivo }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure CargarTabla( var ar: text; var datos: TABLA; tam: integer );\r
+\r
+ var\r
+ i: integer;\r
+ void: string[2];\r
+\r
+ begin\r
+ for i:= 1 to tam do\r
+ begin\r
+ readln( ar, datos[i].ap );\r
+ readln( ar, datos[i].dni );\r
+ readln( ar, void );\r
+ end;\r
+ end; { procedure CargarTabla }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure Intercambiar( var a, b: PERSONA; var int: longint );\r
+\r
+ var\r
+ aux: PERSONA;\r
+\r
+ begin\r
+ int := int + 1;\r
+ Retardar( RETARDO );\r
+ aux := a;\r
+ int := int + 1;\r
+ Retardar( RETARDO );\r
+ a := b;\r
+ int := int + 1;\r
+ Retardar( RETARDO );\r
+ b := aux;\r
+ end; { procedure Intercambiar }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure GetHora( var hor: HORA );\r
+\r
+ var\r
+ h, m, s, c: word;\r
+\r
+ begin\r
+ gettime( h, m, s, c );\r
+ hor.h := h;\r
+ hor.m := m;\r
+ hor.s := s;\r
+ hor.c := c;\r
+ end; { procedure GetHora }\r
+\r
+ (*********************************************************)\r
+\r
+ function GetTiempo( h1, h2: HORA ): longint;\r
+\r
+ var\r
+ t: longint;\r
+ aux: HORA;\r
+\r
+ begin\r
+ if h1.h <> h2.h then { pone al menor como h2 y al mayor como h1 }\r
+ begin\r
+ if h1.h < h2.h then\r
+ begin\r
+ aux := h1;\r
+ h1 := h2;\r
+ h2 := aux;\r
+ end\r
+ end\r
+ else if h1.m <> h2.m then\r
+ begin\r
+ if h1.m < h2.m then\r
+ begin\r
+ aux := h1;\r
+ h1 := h2;\r
+ h2 := aux;\r
+ end\r
+ end\r
+ else if h1.s <> h2.s then\r
+ begin\r
+ if h1.s < h2.s then\r
+ begin\r
+ aux := h1;\r
+ h1 := h2;\r
+ h2 := aux;\r
+ end\r
+ end\r
+ else if h1.c <> h2.c then\r
+ if h1.c < h2.c then\r
+ begin\r
+ aux := h1;\r
+ h1 := h2;\r
+ h2 := aux;\r
+ end;\r
+ t := ( ( ( h1.h - h2.h ) * 60 + ( h1.m - h2.m ) ) * 60 + ( h1.s - h2.s ) ) * 100 + ( h1.c - h2.c );\r
+ GetTiempo := t;\r
+ end; { function GetTiempo }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure EvaluarCre( var datos: TABLA; var arch: text );\r
+\r
+ (*********************************************************)\r
+\r
+ procedure BubbleSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION );\r
+\r
+ var\r
+ i, j: integer;\r
+ h1, h2: HORA;\r
+\r
+ begin\r
+ GetHora( h1 );\r
+ m.Comp := 0;\r
+ m.Int := 0;\r
+ reset( arch );\r
+ CargarTabla( arch, datos, 1000 );\r
+ close( arch );\r
+ for i := tam - 1 downto 1 do\r
+ begin\r
+ for j := tam - 1 downto 1 do\r
+ begin\r
+ m.Comp := m.Comp + 1;\r
+ Retardar( RETARDO );\r
+ if datos[j].ap > datos[j+1].ap then\r
+ Intercambiar( datos[j], datos[j+1], m.Int);\r
+ end;\r
+ end;\r
+ GetHora( h2 );\r
+ m.Tiem := GetTiempo( h1, h2 );\r
+ end; { procedure BubbleSort }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure BubbleSortMej( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION );\r
+\r
+ var\r
+ huboint: boolean;\r
+ i, n: integer;\r
+ h1, h2: HORA;\r
+\r
+ begin\r
+ GetHora( h1 );\r
+ m.Comp := 0;\r
+ m.Int := 0;\r
+ n := 1;\r
+ reset( arch );\r
+ CargarTabla( arch, datos, 1000 );\r
+ close( arch );\r
+ huboint := true;\r
+ while huboint do\r
+ begin\r
+ huboint := false;\r
+ for i := tam - 1 downto n do\r
+ begin\r
+ m.Comp := m.Comp + 1;\r
+ Retardar( RETARDO );\r
+ if datos[i].ap > datos[i+1].ap then\r
+ begin\r
+ Intercambiar( datos[i], datos[i+1], m.Int);\r
+ huboint := true;\r
+ end;\r
+ end;\r
+ n := n + 1;\r
+ end;\r
+ GetHora( h2 );\r
+ m.Tiem := GetTiempo( h1, h2 );\r
+ end; { procedure BubbleSortMej }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure ShakeSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION );\r
+ var\r
+ h1, h2: HORA;\r
+ i, d, j, tmp: integer;\r
+\r
+ begin\r
+ GetHora( h1 );\r
+ m.Comp := 0;\r
+ m.Int := 0;\r
+ reset( arch );\r
+ CargarTabla( arch, datos, 1000 );\r
+ close( arch );\r
+ i := 2;\r
+ d := tam;\r
+ tmp := tam;\r
+ repeat\r
+ for j := d downto i do\r
+ begin\r
+ m.Comp := m.Comp + 1;\r
+ Retardar( RETARDO );\r
+ if datos[j].ap < datos[j-1].ap then\r
+ begin\r
+ Intercambiar( datos[j], datos[j-1], m.Int );\r
+ tmp := j;\r
+ end;\r
+ end;\r
+ i := tmp + 1;\r
+ for j := i to d do\r
+ begin\r
+ m.Comp := m.Comp + 1;\r
+ Retardar( RETARDO );\r
+ if datos[j].ap < datos[j-1].ap then\r
+ begin\r
+ Intercambiar( datos[j], datos[j-1], m.Int );\r
+ tmp := j;\r
+ end;\r
+ end;\r
+ d := tmp - 1;\r
+ until i >= d;\r
+ GetHora( h2 );\r
+ m.Tiem := GetTiempo( h1, h2 );\r
+ end; { procedure ShakeSort }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure RippleSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION );\r
+ var\r
+ h1, h2: HORA;\r
+ i, j: integer;\r
+\r
+ begin\r
+ GetHora( h1 );\r
+ m.Comp := 0;\r
+ m.Int := 0;\r
+ reset( arch );\r
+ CargarTabla( arch, datos, 1000 );\r
+ close( arch );\r
+ for i := 1 to tam do\r
+ begin\r
+ for j := i + 1 to tam do\r
+ begin\r
+ m.Comp := m.Comp + 1;\r
+ Retardar( RETARDO );\r
+ if datos[i].ap > datos[j].ap then Intercambiar( datos[i], datos[j], m.Int );\r
+ end;\r
+ end;\r
+ GetHora( h2 );\r
+ m.Tiem := GetTiempo( h1, h2 );\r
+ end; { procedure RippleSort }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure SelectionSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION );\r
+ var\r
+ i, sel, n: integer;\r
+ hubosel: boolean;\r
+ h1, h2: HORA;\r
+\r
+ begin\r
+ GetHora( h1 );\r
+ m.Comp := 0;\r
+ m.Int := 0;\r
+ reset( arch );\r
+ CargarTabla( arch, datos, 1000 );\r
+ close( arch );\r
+ for n := 1 to tam - 1 do\r
+ begin\r
+ hubosel := false;\r
+ sel := n;\r
+ for i := n + 1 to tam do\r
+ begin\r
+ m.Comp := m.Comp + 1;\r
+ Retardar( RETARDO );\r
+ if datos[sel].ap > datos[i].ap then\r
+ begin\r
+ sel := i;\r
+ hubosel := true;\r
+ end;\r
+ end;\r
+ if hubosel then Intercambiar( datos[n], datos[sel], m.Int);\r
+ end;\r
+ GetHora( h2 );\r
+ m.Tiem := GetTiempo( h1, h2 );\r
+ end; { procedure SelectionSort }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure InsertionSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION );\r
+ var\r
+ h1, h2: HORA;\r
+ i, j, k: integer;\r
+ tmp: PERSONA;\r
+ terminar: boolean;\r
+\r
+ begin\r
+ GetHora( h1 );\r
+ m.Comp := 0;\r
+ m.Int := 0;\r
+ reset( arch );\r
+ CargarTabla( arch, datos, 1000 );\r
+ close( arch );\r
+ for i := 2 to tam do\r
+ begin\r
+ tmp := datos[i];\r
+ j := i - 1;\r
+ terminar := false;\r
+ while ( j >= 1 ) and ( not terminar ) do\r
+ begin\r
+ m.Comp := m.Comp + 1;\r
+ Retardar( RETARDO );\r
+ if ( tmp.ap < datos[j].ap ) then\r
+ begin\r
+ m.Int := m.Int + 1;\r
+ Retardar( RETARDO );\r
+ datos[j+1] := datos[j];\r
+ j := j - 1;\r
+ end\r
+ else terminar := true;\r
+ end;\r
+ m.Int := m.Int + 1;\r
+ Retardar( RETARDO );\r
+ datos[j+1] := tmp;\r
+ end;\r
+ GetHora( h2 );\r
+ m.Tiem := GetTiempo( h1, h2 );\r
+ end; { procedure InsertionSort }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure ShellSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION );\r
+ var\r
+ h1, h2: HORA;\r
+ hueco, i, j: integer;\r
+ huboint: boolean;\r
+\r
+ begin\r
+ GetHora( h1 );\r
+ m.Comp := 0;\r
+ m.Int := 0;\r
+ reset( arch );\r
+ CargarTabla( arch, datos, 1000 );\r
+ close( arch );\r
+ hueco := tam;\r
+ while hueco > 1 do\r
+ begin\r
+ hueco := hueco div 2;\r
+ huboint := true;\r
+ while huboint do\r
+ begin\r
+ huboint := false;\r
+ for i := 1 to tam - hueco do\r
+ begin\r
+ j := i + hueco;\r
+ m.Comp := m.Comp + 1;\r
+ Retardar( RETARDO );\r
+ if ( datos[i].ap > datos[j].ap ) then\r
+ begin\r
+ Intercambiar( datos[i], datos[j], m.Int );\r
+ huboint := true;\r
+ end;\r
+ end;\r
+ end;\r
+ end;\r
+ GetHora( h2 );\r
+ m.Tiem := GetTiempo( h1, h2 );\r
+ end; { procedure ShellSort }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure ShellSortMej( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION );\r
+\r
+ (*********************************************************)\r
+\r
+ procedure Shell( var datos: TABLA; hueco, i: integer; var comp, int: longint );\r
+ var\r
+ j: integer;\r
+\r
+ begin\r
+ j := i + hueco;\r
+ comp := comp + 1;\r
+ Retardar( RETARDO );\r
+ if ( datos[i].ap > datos[j].ap ) then\r
+ begin\r
+ Intercambiar( datos[i], datos[j], int );\r
+ if (i - hueco) > 0 then\r
+ Shell( datos, hueco, i - hueco, comp, int );\r
+ end;\r
+ end; { procedure Shell }\r
+\r
+ (*********************************************************)\r
+\r
+ var { procedure ShellSortMej }\r
+ h1, h2: HORA;\r
+ hueco, i, j: integer;\r
+\r
+ begin\r
+ GetHora( h1 );\r
+ m.Comp := 0;\r
+ m.Int := 0;\r
+ reset( arch );\r
+ CargarTabla( arch, datos, 1000 );\r
+ close( arch );\r
+ hueco := tam;\r
+ while hueco > 1 do\r
+ begin\r
+ hueco := hueco div 2;\r
+ for i := 1 to tam - hueco do\r
+ begin\r
+ j := i + hueco;\r
+ m.Comp := m.Comp + 1;\r
+ Retardar( RETARDO );\r
+ if ( datos[i].ap > datos[j].ap ) then\r
+ begin\r
+ Intercambiar( datos[i], datos[j], m.Int );\r
+ if (i - hueco) > 0 then\r
+ Shell( datos, hueco, i - hueco, m.Comp, m.Int );\r
+ end;\r
+ end;\r
+ end;\r
+ GetHora( h2 );\r
+ m.Tiem := GetTiempo( h1, h2 );\r
+ end; { procedure ShellSortMej }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure QuickSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION );\r
+\r
+ (*********************************************************)\r
+\r
+ procedure QSort( var datos: TABLA; min, max: integer; var comp, int: longint );\r
+\r
+ var\r
+ i, j: integer;\r
+ sel: PERSONA;\r
+ flag: boolean;\r
+\r
+ begin\r
+ sel := datos[( min + max ) div 2];\r
+ i := min;\r
+ j := max;\r
+ repeat\r
+ comp := comp + 1;\r
+ Retardar( RETARDO );\r
+ flag := false;\r
+ while datos[i].ap < sel.ap do\r
+ begin\r
+ if flag then begin\r
+ comp := comp + 1;\r
+ Retardar( RETARDO );\r
+ end\r
+ else flag := true;\r
+ i := i + 1;\r
+ end;\r
+ comp := comp + 1;\r
+ Retardar( RETARDO );\r
+ flag := false;\r
+ while datos[j].ap > sel.ap do\r
+ begin\r
+ if flag then begin\r
+ comp := comp + 1;\r
+ Retardar( RETARDO );\r
+ end\r
+ else flag := true;\r
+ j := j - 1;\r
+ end;\r
+ if i <= j then\r
+ begin\r
+ if i < j then Intercambiar( datos[i], datos[j], int );\r
+ i := i + 1;\r
+ j := j - 1;\r
+ end;\r
+ until i > j;\r
+ if min < j then QSort( datos, min, j, comp, int);\r
+ if i < max then QSort( datos, i, max, comp, int);\r
+ end; { procedure QSort }\r
+\r
+ (*********************************************************)\r
+\r
+ var\r
+ h1, h2: HORA;\r
+\r
+ begin { procedure QuickSort }\r
+ GetHora( h1 );\r
+ m.Comp := 0;\r
+ m.Int := 0;\r
+ reset( arch );\r
+ CargarTabla( arch, datos, 1000 );\r
+ close( arch );\r
+ QSort( datos, 1, 1000, m.Comp, m.Int );\r
+ GetHora( h2 );\r
+ m.Tiem := GetTiempo( h1, h2 );\r
+ { rewrite( arch );\r
+ CargarArchivo( datos, arch, 1000 );\r
+ close( arch ); }\r
+ end; { procedure QuickSort }\r
+\r
+ (*********************************************************)\r
+\r
+ begin { procedure EvaluarCre }\r
+ if ExisteArchivo( 'DATOS.TXT' ) then\r
+ begin\r
+ BubbleSort( arch, datos, 1000, bs );\r
+ BubbleSortMej( arch, datos, 1000, bsm );\r
+ ShakeSort( arch, datos, 1000, shs );\r
+ RippleSort( arch, datos, 1000, rs );\r
+ SelectionSort( arch, datos, 1000, ss );\r
+ InsertionSort( arch, datos, 1000, is );\r
+ ShellSort( arch, datos, 1000, sls );\r
+ ShellSortMej( arch, datos, 1000, slsm );\r
+ QuickSort( arch, datos, 1000, qs );\r
+ CrearInforme( CRECIENTE );\r
+ end\r
+ else\r
+ NoExisteArch;\r
+ end; { procedure EvaluarCre }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure EvaluarDec( var datos: TABLA; var arch: text );\r
+\r
+ (*********************************************************)\r
+\r
+ procedure BubbleSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION );\r
+\r
+ var\r
+ i, j: integer;\r
+ h1, h2: HORA;\r
+\r
+ begin\r
+ GetHora( h1 );\r
+ m.Comp := 0;\r
+ m.Int := 0;\r
+ reset( arch );\r
+ CargarTabla( arch, datos, 1000 );\r
+ close( arch );\r
+ for i := tam - 1 downto 1 do\r
+ begin\r
+ for j := tam - 1 downto 1 do\r
+ begin\r
+ m.Comp := m.Comp + 1;\r
+ Retardar( RETARDO );\r
+ if datos[j].ap < datos[j+1].ap then\r
+ Intercambiar( datos[j], datos[j+1], m.Int);\r
+ end;\r
+ end;\r
+ GetHora( h2 );\r
+ m.Tiem := GetTiempo( h1, h2 );\r
+ end; { procedure BubbleSort }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure BubbleSortMej( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION );\r
+\r
+ var\r
+ huboint: boolean;\r
+ i, n: integer;\r
+ h1, h2: HORA;\r
+\r
+ begin\r
+ GetHora( h1 );\r
+ m.Comp := 0;\r
+ m.Int := 0;\r
+ n := 1;\r
+ reset( arch );\r
+ CargarTabla( arch, datos, 1000 );\r
+ close( arch );\r
+ huboint := true;\r
+ while huboint do\r
+ begin\r
+ huboint := false;\r
+ for i := tam - 1 downto n do\r
+ begin\r
+ m.Comp := m.Comp + 1;\r
+ Retardar( RETARDO );\r
+ if datos[i].ap < datos[i+1].ap then\r
+ begin\r
+ Intercambiar( datos[i], datos[i+1], m.Int);\r
+ huboint := true;\r
+ end;\r
+ end;\r
+ n := n + 1;\r
+ end;\r
+ GetHora( h2 );\r
+ m.Tiem := GetTiempo( h1, h2 );\r
+ end; { procedure BubbleSortMej }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure ShakeSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION );\r
+ var\r
+ h1, h2: HORA;\r
+ i, d, j, tmp: integer;\r
+\r
+ begin\r
+ GetHora( h1 );\r
+ m.Comp := 0;\r
+ m.Int := 0;\r
+ reset( arch );\r
+ CargarTabla( arch, datos, 1000 );\r
+ close( arch );\r
+ i := 2;\r
+ d := tam;\r
+ tmp := tam;\r
+ repeat\r
+ for j := d downto i do\r
+ begin\r
+ m.Comp := m.Comp + 1;\r
+ Retardar( RETARDO );\r
+ if datos[j].ap > datos[j-1].ap then\r
+ begin\r
+ Intercambiar( datos[j], datos[j-1], m.Int );\r
+ tmp := j;\r
+ end;\r
+ end;\r
+ i := tmp + 1;\r
+ for j := i to d do\r
+ begin\r
+ m.Comp := m.Comp + 1;\r
+ Retardar( RETARDO );\r
+ if datos[j].ap > datos[j-1].ap then\r
+ begin\r
+ Intercambiar( datos[j], datos[j-1], m.Int );\r
+ tmp := j;\r
+ end;\r
+ end;\r
+ d := tmp - 1;\r
+ until i >= d;\r
+ GetHora( h2 );\r
+ m.Tiem := GetTiempo( h1, h2 );\r
+ end; { procedure ShakeSort }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure RippleSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION );\r
+ var\r
+ h1, h2: HORA;\r
+ i, j: integer;\r
+\r
+ begin\r
+ GetHora( h1 );\r
+ m.Comp := 0;\r
+ m.Int := 0;\r
+ reset( arch );\r
+ CargarTabla( arch, datos, 1000 );\r
+ close( arch );\r
+ for i := 1 to tam do\r
+ begin\r
+ for j := i + 1 to tam do\r
+ begin\r
+ m.Comp := m.Comp + 1;\r
+ Retardar( RETARDO );\r
+ if datos[i].ap < datos[j].ap then Intercambiar( datos[i], datos[j], m.Int );\r
+ end;\r
+ end;\r
+ GetHora( h2 );\r
+ m.Tiem := GetTiempo( h1, h2 );\r
+ end; { procedure RippleSort }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure SelectionSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION );\r
+ var\r
+ i, sel, n: integer;\r
+ hubosel: boolean;\r
+ h1, h2: HORA;\r
+\r
+ begin\r
+ GetHora( h1 );\r
+ m.Comp := 0;\r
+ m.Int := 0;\r
+ reset( arch );\r
+ CargarTabla( arch, datos, 1000 );\r
+ close( arch );\r
+ for n := 1 to tam - 1 do\r
+ begin\r
+ hubosel := false;\r
+ sel := n;\r
+ for i := n + 1 to tam do\r
+ begin\r
+ m.Comp := m.Comp + 1;\r
+ Retardar( RETARDO );\r
+ if datos[sel].ap < datos[i].ap then\r
+ begin\r
+ sel := i;\r
+ hubosel := true;\r
+ end;\r
+ end;\r
+ if hubosel then Intercambiar( datos[n], datos[sel], m.Int);\r
+ end;\r
+ GetHora( h2 );\r
+ m.Tiem := GetTiempo( h1, h2 );\r
+ end; { procedure SelectionSort }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure InsertionSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION );\r
+ var\r
+ h1, h2: HORA;\r
+ i, j, k: integer;\r
+ tmp: PERSONA;\r
+ terminar: boolean;\r
+\r
+ begin\r
+ GetHora( h1 );\r
+ m.Comp := 0;\r
+ m.Int := 0;\r
+ reset( arch );\r
+ CargarTabla( arch, datos, 1000 );\r
+ close( arch );\r
+ for i := 2 to tam do\r
+ begin\r
+ tmp := datos[i];\r
+ j := i - 1;\r
+ terminar := false;\r
+ while ( j >= 1 ) and ( not terminar ) do\r
+ begin\r
+ m.Comp := m.Comp + 1;\r
+ Retardar( RETARDO );\r
+ if ( tmp.ap > datos[j].ap ) then\r
+ begin\r
+ m.Int := m.Int + 1;\r
+ Retardar( RETARDO );\r
+ datos[j+1] := datos[j];\r
+ j := j - 1;\r
+ end\r
+ else terminar := true;\r
+ end;\r
+ m.Int := m.Int + 1;\r
+ Retardar( RETARDO );\r
+ datos[j+1] := tmp;\r
+ end;\r
+ GetHora( h2 );\r
+ m.Tiem := GetTiempo( h1, h2 );\r
+ end; { procedure InsertionSort }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure ShellSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION );\r
+ var\r
+ h1, h2: HORA;\r
+ hueco, i, j: integer;\r
+ huboint: boolean;\r
+\r
+ begin\r
+ GetHora( h1 );\r
+ m.Comp := 0;\r
+ m.Int := 0;\r
+ reset( arch );\r
+ CargarTabla( arch, datos, 1000 );\r
+ close( arch );\r
+ hueco := tam;\r
+ while hueco > 1 do\r
+ begin\r
+ hueco := hueco div 2;\r
+ huboint := true;\r
+ while huboint do\r
+ begin\r
+ huboint := false;\r
+ for i := 1 to tam - hueco do\r
+ begin\r
+ j := i + hueco;\r
+ m.Comp := m.Comp + 1;\r
+ Retardar( RETARDO );\r
+ if ( datos[i].ap < datos[j].ap ) then\r
+ begin\r
+ Intercambiar( datos[i], datos[j], m.Int );\r
+ huboint := true;\r
+ end;\r
+ end;\r
+ end;\r
+ end;\r
+ GetHora( h2 );\r
+ m.Tiem := GetTiempo( h1, h2 );\r
+ end; { procedure ShellSort }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure ShellSortMej( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION );\r
+\r
+ (*********************************************************)\r
+\r
+ procedure Shell( var datos: TABLA; hueco, i: integer;\r
+ var comp: longint; var int: longint );\r
+ var\r
+ j: integer;\r
+\r
+ begin\r
+ j := i + hueco;\r
+ comp := comp + 1;\r
+ Retardar( RETARDO );\r
+ if ( datos[i].ap < datos[j].ap ) then\r
+ begin\r
+ Intercambiar( datos[i], datos[j], int );\r
+ if (i - hueco) > 0 then\r
+ Shell( datos, hueco, i - hueco, comp, int );\r
+ end;\r
+ end; { procedure Shell }\r
+\r
+ (*********************************************************)\r
+\r
+ var { procedure ShellSortMej }\r
+ h1, h2: HORA;\r
+ hueco, i, j: integer;\r
+\r
+ begin\r
+ GetHora( h1 );\r
+ m.Comp := 0;\r
+ m.Int := 0;\r
+ reset( arch );\r
+ CargarTabla( arch, datos, 1000 );\r
+ close( arch );\r
+ hueco := tam;\r
+ while hueco > 1 do\r
+ begin\r
+ hueco := hueco div 2;\r
+ for i := 1 to tam - hueco do\r
+ begin\r
+ j := i + hueco;\r
+ m.Comp := m.Comp + 1;\r
+ Retardar( RETARDO );\r
+ if ( datos[i].ap < datos[j].ap ) then\r
+ begin\r
+ Intercambiar( datos[i], datos[j], m.Int );\r
+ if (i - hueco) > 0 then\r
+ Shell( datos, hueco, i - hueco, m.Comp, m.Int );\r
+ end;\r
+ end;\r
+ end;\r
+ GetHora( h2 );\r
+ m.Tiem := GetTiempo( h1, h2 );\r
+ end; { procedure ShellSortMej }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure QuickSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION );\r
+\r
+ procedure QSort( var datos: TABLA; min, max: integer;\r
+ var comp: longint; var int: longint );\r
+\r
+ var\r
+ i, j: integer;\r
+ sel: PERSONA;\r
+ flag: boolean;\r
+\r
+ begin\r
+ sel := datos[( min + max ) div 2];\r
+ i := min;\r
+ j := max;\r
+ repeat\r
+ comp := comp + 1;\r
+ Retardar( RETARDO );\r
+ flag := false;\r
+ while datos[i].ap > sel.ap do\r
+ begin\r
+ if flag then begin\r
+ comp := comp + 1;\r
+ Retardar( RETARDO );\r
+ end\r
+ else flag := true;\r
+ i := i + 1;\r
+ end;\r
+ comp := comp + 1;\r
+ Retardar( RETARDO );\r
+ flag := false;\r
+ while datos[j].ap < sel.ap do\r
+ begin\r
+ if flag then begin\r
+ comp := comp + 1;\r
+ Retardar( RETARDO );\r
+ end\r
+ else flag := true;\r
+ j := j - 1;\r
+ end;\r
+ if i <= j then\r
+ begin\r
+ if i < j then Intercambiar( datos[i], datos[j], int );\r
+ i := i + 1;\r
+ j := j - 1;\r
+ end;\r
+ until i > j;\r
+ if min < j then QSort( datos, min, j, comp, int);\r
+ if i < max then QSort( datos, i, max, comp, int);\r
+ end; { procedure QSort }\r
+\r
+ (*********************************************************)\r
+\r
+ var\r
+ h1, h2: HORA;\r
+\r
+ begin { procedure QuickSort }\r
+ GetHora( h1 );\r
+ m.Comp := 0;\r
+ m.Int := 0;\r
+ reset( arch );\r
+ CargarTabla( arch, datos, 1000 );\r
+ close( arch );\r
+ QSort( datos, 1, 1000, m.Comp, m.Int );\r
+ GetHora( h2 );\r
+ m.Tiem := GetTiempo( h1, h2 );\r
+ end; { procedure QuickSort }\r
+\r
+ (*********************************************************)\r
+\r
+ begin { procedure EvaluarDec }\r
+ if ExisteArchivo( 'DATOS.TXT' ) then\r
+ begin\r
+ BubbleSort( arch, datos, 1000, bs );\r
+ BubbleSortMej( arch, datos, 1000, bsm );\r
+ ShakeSort( arch, datos, 1000, shs );\r
+ RippleSort( arch, datos, 1000, rs );\r
+ SelectionSort( arch, datos, 1000, ss );\r
+ InsertionSort( arch, datos, 1000, is );\r
+ ShellSort( arch, datos, 1000, sls );\r
+ ShellSortMej( arch, datos, 1000, slsm );\r
+ QuickSort( arch, datos, 1000, qs );\r
+ CrearInforme( DECRECIENTE );\r
+ end\r
+ else\r
+ NoExisteArch;\r
+ end; { procedure EvaluarDec }\r
+\r
+ (*********************************************************)\r
+\r
+ var { procedure MenuEvaluar }\r
+ tecla: char;\r
+\r
+ begin\r
+ clrscr;\r
+ textcolor( Yellow );\r
+ gotoxy( 19, 3 );\r
+ writeln( 'COMPARACION DE ALGORITMOS DE ORDENAMIENTO' );\r
+ gotoxy( 19, 4 );\r
+ writeln( '~~~~~~~~~~~ ~~ ~~~~~~~~~~ ~~ ~~~~~~~~~~~~' );\r
+ textcolor( LightCyan );\r
+ gotoxy( 1, 7 );\r
+ writeln( ' Evaluar Algoritmos:' );\r
+ writeln( ' ------- ----------' );\r
+ textcolor( LightGray );\r
+ writeln;\r
+ writeln;\r
+ writeln( ' 1.- Ordenando en forma creciente.' );\r
+ writeln( ' 2.- Ordenando en forma decreciente.' );\r
+ writeln( ' 0.- Men£ Anterior.' );\r
+ gotoxy( 1, 20 );\r
+ textcolor( White );\r
+ write( ' Ingrese su opci¢n: ' );\r
+ textcolor( Yellow );\r
+ tecla := readkey;\r
+ while ( ( tecla < '1' ) or ( tecla > '2' ) ) and ( tecla <> '0' ) do\r
+ begin\r
+ textcolor( White );\r
+ gotoxy( 1, 20 );\r
+ write( ' Ingrese su opci¢n (1, 2 o 0): ' );\r
+ textcolor( Yellow );\r
+ tecla := readkey;\r
+ end;\r
+ case tecla of\r
+ '1': if ExisteArchivo( 'DATOS.TXT' ) then EvaluarCre( datos, arch )\r
+ else NoExisteArch;\r
+ '2': if ExisteArchivo( 'DATOS.TXT' ) then EvaluarDec( datos, arch )\r
+ else NoExisteArch;\r
+ '0': ;\r
+ end;\r
+ end;\r
+\r
+(*********************************************************)\r
+(*********************************************************)\r
+\r
+ procedure MenuGenerar( var arch: text );\r
+\r
+ (*********************************************************)\r
+\r
+ function GetRNDApellido( max, min: integer ): APELLIDO;\r
+\r
+ (*********************************************************)\r
+\r
+ function GetVocal( tipo: TIPO_VOCAL ): char;\r
+\r
+ var\r
+ valor: integer;\r
+\r
+ begin\r
+ if tipo = TV_AEIOU then valor := random( 16 )\r
+ else valor := random( 6 ) + 5;\r
+ case valor of\r
+ 0..4: GetVocal := 'A';\r
+ 5..7: GetVocal := 'E';\r
+ 8..10: GetVocal := 'I';\r
+ 11..13: GetVocal := 'O';\r
+ 14..15: GetVocal := 'U';\r
+ end;\r
+ end; { function GetVocal }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure GetRNDVocal( var indic: INDICADOR; var proxl: TIPO_LETRA; var vocal: char );\r
+\r
+ var\r
+ valor: integer;\r
+\r
+ begin\r
+ case indic of\r
+ I_ESQ:\r
+ begin\r
+ vocal := 'U';\r
+ indic := I_ESQU;\r
+ proxl := TL_VOCAL;\r
+ end;\r
+ I_ESQU:\r
+ begin\r
+ vocal := GetVocal( TV_EI );\r
+ indic := I_NADA;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ else\r
+ begin\r
+ vocal := GetVocal( TV_AEIOU );\r
+ indic := I_NADA;\r
+ if random( 40 ) = 0 then proxl := TL_VOCAL\r
+ else proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ end; { procedure GetRNDVocal }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure GetRNDConsonante( var indic: INDICADOR; var proxl: TIPO_LETRA; var conso: char );\r
+\r
+ var\r
+ valor: integer;\r
+\r
+ begin\r
+ proxl := TL_VOCAL;\r
+ indic := I_NADA;\r
+\r
+ case indic of\r
+ I_ESF, I_ESR, I_ESG, I_EST: conso := 'R';\r
+ I_ESB: case random( 2 ) of\r
+ 0: conso := 'R';\r
+ 1: conso := 'L';\r
+ end;\r
+ I_ESC: case random( 4 ) of\r
+ 0: conso := 'C';\r
+ 1: conso := 'H';\r
+ 2: conso := 'R';\r
+ 3: conso := 'L';\r
+ end;\r
+ I_ESL: case random( 6 ) of\r
+ 0: conso := 'T';\r
+ 1..5: conso := 'L';\r
+ end;\r
+ I_ESM: case random( 3 ) of\r
+ 0: conso := 'P';\r
+ 1: conso := 'B';\r
+ 2: conso := 'L';\r
+ end;\r
+ I_ESN: case random( 3 ) of\r
+ 0: conso := 'R';\r
+ 1: conso := 'V';\r
+ 2: conso := 'C';\r
+ end;\r
+ else case random( 55 ) of\r
+ 0..3: begin\r
+ conso := 'B';\r
+ if random( 10 ) = 0 then begin\r
+ indic := I_ESB;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 4..7: begin\r
+ conso := 'C';\r
+ if random( 5 ) = 0 then begin\r
+ indic := I_ESC;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 8..11: conso := 'D';\r
+ 12..14: begin\r
+ conso := 'F';\r
+ if random( 10 ) = 0 then begin\r
+ indic := I_ESF;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 15..17: begin\r
+ conso := 'G';\r
+ if random( 5 ) = 0 then\r
+ begin\r
+ indic := I_ESG;\r
+ if random( 4 ) = 0 then proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 18..19: conso := 'H';\r
+ 20..22: conso := 'J';\r
+ 23..24: conso := 'K';\r
+ 25..27: begin\r
+ conso := 'L';\r
+ if random( 15 ) = 0 then\r
+ begin\r
+ indic := I_ESL;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 28..30: begin\r
+ conso := 'M';\r
+ if random( 5 ) = 0 then\r
+ begin\r
+ indic := I_ESM;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 31..33: begin\r
+ conso := 'N';\r
+ if random( 5 ) = 0 then\r
+ begin\r
+ indic := I_ESN;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 34..36: conso := 'P';\r
+ 37..38: begin\r
+ conso := 'Q';\r
+ indic := I_ESQ;\r
+ end;\r
+ 39..41: begin\r
+ conso := 'R';\r
+ if random( 3 ) = 0 then\r
+ begin\r
+ indic := I_ESR;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 42..44: conso := 'S';\r
+ 45..47: begin\r
+ conso := 'T';\r
+ if random( 10 ) = 0 then\r
+ begin\r
+ indic := I_EST;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 48..50: conso := 'V';\r
+ 51: conso := 'W';\r
+ 52: conso := 'X';\r
+ 53: conso := 'Y';\r
+ 54: conso := 'Z';\r
+ end; { case random( 55 ) of }\r
+\r
+ end; { case indic of }\r
+ end; { procedure GetRNDConsonante }\r
+\r
+ (*********************************************************)\r
+\r
+ var { function GetRNDApellido }\r
+ tam, i: integer;\r
+ aux: char;\r
+ apel: APELLIDO;\r
+ indic: INDICADOR;\r
+ proxl: TIPO_LETRA;\r
+\r
+ begin\r
+ if max > MAX_APE then max := MAX_APE;\r
+ tam := random( max + 1 ) + min;\r
+ indic := I_NADA;\r
+ apel := '';\r
+ if random( 5 ) = 0 then proxl := TL_VOCAL\r
+ else proxl := TL_CONSO;\r
+ for i := 1 to tam do\r
+ begin\r
+ if proxl = TL_CONSO then GetRNDConsonante( indic, proxl, aux )\r
+ else GetRNDVocal( indic, proxl, aux );\r
+ apel := apel + aux;\r
+ end;\r
+ GetRNDApellido := apel;\r
+ end; { function GetRNDApellido }\r
+\r
+ (*********************************************************)\r
+\r
+ function GetRNDLetra( min, max: char ): char;\r
+\r
+ begin\r
+ GetRNDLetra := chr( random( ord( max ) - ord( min ) + 1 ) + ord( min ) );\r
+ end;\r
+\r
+ (*********************************************************)\r
+\r
+ procedure GetOrdApellidos( var ar: text; cant: integer );\r
+\r
+ var\r
+ mil: boolean;\r
+ letra, letra1: char;\r
+ i, j, veces: integer;\r
+ dni: DOCUMENTO;\r
+ ap, ape, apel: APELLIDO;\r
+\r
+ begin\r
+ mil := false;\r
+ if cant = 1000 then mil := true;\r
+ dni := 10000000 + (random( 15000 ) * 100);\r
+ ap := '';\r
+ ape := '';\r
+ apel := '';\r
+ for letra := 'A' to 'Z' do\r
+ begin\r
+ ap := letra;\r
+ for letra1 := 'A' to 'Z' do\r
+ begin\r
+ if mil then\r
+ case letra of\r
+ 'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T':\r
+ case letra1 of\r
+ 'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T', 'Z': veces := 2;\r
+ else veces := 1;\r
+ end;\r
+ else case letra1 of\r
+ 'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T': veces := 2;\r
+ else veces := 1;\r
+ end;\r
+ end\r
+ else\r
+ case letra of\r
+ 'A', 'B', 'C', 'D', 'E', 'F', 'I', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T', 'V':\r
+ case letra1 of\r
+ 'D', 'F', 'G', 'H', 'I', 'J', 'K', 'U', 'V': veces := 2;\r
+ else veces := 1;\r
+ end;\r
+ else case letra1 of\r
+ 'D', 'F', 'G', 'H', 'I', 'J', 'K', 'U': veces := 2;\r
+ else veces := 1;\r
+ end;\r
+ end;\r
+ ape := ap + letra1;\r
+ for j := 1 to veces do\r
+ begin\r
+ if j = 1 then apel := ape + GetRNDLetra( 'A', 'M' ) + GetRNDApellido( 6, 1 )\r
+ else apel := ape + GetRNDLetra( 'N', 'Z' ) + GetRNDApellido( 6, 1 );\r
+ dni := dni + random( 50000 ) + 1;\r
+ writeln( ar, apel );\r
+ writeln( ar, dni );\r
+ writeln( ar );\r
+ apel := '';\r
+ end;\r
+\r
+ ape := '';\r
+\r
+ end; { for letra1 := 'A' to 'Z' do }\r
+\r
+ ap := '';\r
+\r
+ end; { for letra := 'A' to 'Z' do }\r
+\r
+ end; { procedure GetOrdApellidos }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure GetInvOrdApellidos( var ar: text; cant: integer );\r
+\r
+ var\r
+ mil: boolean;\r
+ letra, letra1: char;\r
+ i, j, veces: integer;\r
+ dni: DOCUMENTO;\r
+ ap, ape, apel: APELLIDO;\r
+\r
+ begin\r
+ mil := false;\r
+ if cant = 1000 then mil := true;\r
+ dni := 34000000 + (random( 15000 ) * 100);\r
+ ap := '';\r
+ ape := '';\r
+ apel := '';\r
+ for letra := 'Z' downto 'A' do\r
+ begin\r
+ ap := letra;\r
+ for letra1 := 'Z' downto 'A' do\r
+ begin\r
+ if mil then\r
+ case letra of\r
+ 'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T':\r
+ case letra1 of\r
+ 'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T', 'Z': veces := 2;\r
+ else veces := 1;\r
+ end;\r
+ else case letra1 of\r
+ 'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T': veces := 2;\r
+ else veces := 1;\r
+ end;\r
+ end\r
+ else\r
+ case letra of\r
+ 'A', 'B', 'C', 'D', 'E', 'F', 'I', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T', 'V':\r
+ case letra1 of\r
+ 'D', 'F', 'G', 'H', 'I', 'J', 'K', 'U', 'V': veces := 2;\r
+ else veces := 1;\r
+ end;\r
+ else case letra1 of\r
+ 'D', 'F', 'G', 'H', 'I', 'J', 'K', 'U': veces := 2;\r
+ else veces := 1;\r
+ end;\r
+ end;\r
+ ape := ap + letra1;\r
+ for j := 1 to veces do\r
+ begin\r
+ if j <> 1 then apel := ape + GetRNDLetra( 'A', 'M' ) + GetRNDApellido( 6, 1 )\r
+ else apel := ape + GetRNDLetra( 'N', 'Z' ) + GetRNDApellido( 6, 1 );\r
+ dni := dni - random( 40000 ) - 1;\r
+ writeln( ar, apel );\r
+ writeln( ar, dni );\r
+ writeln( ar );\r
+ apel := '';\r
+ end;\r
+\r
+ ape := '';\r
+\r
+ end; { for letra1 := 'A' to 'Z' do }\r
+\r
+ ap := '';\r
+\r
+ end; { for letra := 'A' to 'Z' do }\r
+\r
+ end; { GetInvOrdApellidos }\r
+\r
+\r
+ (*********************************************************)\r
+\r
+ procedure GenerarRND( var arch: text; n: integer; reabrir: boolean );\r
+\r
+ var\r
+ i: integer;\r
+ ap: APELLIDO;\r
+ dni: DOCUMENTO;\r
+\r
+ begin\r
+ if reabrir then rewrite( arch );\r
+ dni := 10000000 + (random( 15000 ) * 100);\r
+\r
+ for i := 1 to n do\r
+ begin\r
+ ap := GetRNDApellido( 8, 4 );\r
+ dni := dni + random( 50000 ) + 1;\r
+ writeln( arch, ap );\r
+ writeln( arch, dni );\r
+ writeln( arch );\r
+ end;\r
+ if reabrir then close( arch );\r
+ end; { procedure GenerarRND }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure GenerarOrd( var arch: text; n: integer; reabrir: boolean );\r
+\r
+ begin\r
+ if reabrir then rewrite( arch );\r
+ GetOrdApellidos( arch, n );\r
+ if reabrir then close( arch );\r
+ end;\r
+\r
+ (*********************************************************)\r
+\r
+ procedure GenerarOrdDec( var arch: text; n: integer; reabrir: boolean );\r
+\r
+ begin\r
+ if reabrir then rewrite( arch );\r
+ GetInvOrdApellidos( arch, n );\r
+ if reabrir then close( arch );\r
+ end;\r
+\r
+ (*********************************************************)\r
+\r
+ procedure Generar90Ord( var arch: text );\r
+\r
+ begin\r
+ rewrite( arch );\r
+ GenerarOrd( arch, 900, false );\r
+ GenerarRND( arch, 100, false );\r
+ close( arch );\r
+ end;\r
+\r
+ (*********************************************************)\r
+\r
+ procedure Generar90OrdDec( var arch: text );\r
+\r
+ begin\r
+ rewrite( arch );\r
+ GenerarOrdDec( arch, 900, false );\r
+ GenerarRND( arch, 100, false );\r
+ close( arch );\r
+ end;\r
+\r
+ (*********************************************************)\r
+\r
+ var { procedure MenuGenerar }\r
+ tecla: char;\r
+\r
+ begin\r
+ clrscr;\r
+ textcolor( Yellow );\r
+ gotoxy( 19, 3 );\r
+ writeln( 'COMPARACION DE ALGORITMOS DE ORDENAMIENTO' );\r
+ gotoxy( 19, 4 );\r
+ writeln( '~~~~~~~~~~~ ~~ ~~~~~~~~~~ ~~ ~~~~~~~~~~~~' );\r
+ textcolor( LightCyan );\r
+ gotoxy( 1, 7 );\r
+ writeln( ' Generar Archivo (''DATOS.TXT''):' );\r
+ writeln( ' ------- ------- -------------' );\r
+ textcolor( LightGray );\r
+ writeln;\r
+ writeln;\r
+ writeln( ' 1.- Con datos desordenados.' );\r
+ writeln( ' 2.- Con datos en orden creciente (APELLIDO, DNI).' );\r
+ writeln( ' 3.- Con datos en orden decreciente (APELLIDO, DNI).' );\r
+ writeln( ' 4.- Con 90% datos en orden creciente (APELLIDO, DNI) + 10% desordenado.' );\r
+ writeln( ' 5.- Con 90% datos en orden decreciente (APELLIDO, DNI) + 10% desordenado.' );\r
+ writeln( ' 0.- Men£ Anterior.' );\r
+ gotoxy( 1, 20 );\r
+ textcolor( White );\r
+ write( ' Ingrese su opci¢n: ' );\r
+ textcolor( Yellow );\r
+ tecla := readkey;\r
+ while ( ( tecla < '1' ) or ( tecla > '5' ) ) and ( tecla <> '0' ) do\r
+ begin\r
+ textcolor( White );\r
+ gotoxy( 1, 20 );\r
+ write( ' Ingrese su opci¢n (1 a 5 o 0): ' );\r
+ textcolor( Yellow );\r
+ tecla := readkey;\r
+ end;\r
+ case tecla of\r
+ '1': GenerarRND( arch, 1000, true );\r
+ '2': GenerarOrd( arch, 1000, true );\r
+ '3': GenerarOrdDec( arch, 1000, true );\r
+ '4': Generar90Ord( arch );\r
+ '5': Generar90OrdDec( arch );\r
+ '0': ;\r
+ end;\r
+ end; { procedure MenuGenerar }\r
+\r
+(*********************************************************)\r
+\r
+ procedure PantallaSalida;\r
+\r
+ begin\r
+ writeln;\r
+ NormVideo;\r
+ clrscr;\r
+ writeln;\r
+ textcolor( white );\r
+ writeln( ' COMPARACION DE ALGORITMOS DE ORDENAMIENTO versi¢n ', VERSION, ' <-o-o-> Luca - Soft' );\r
+ NormVideo;\r
+ writeln( ' Desarrollado por Leandro Lucarella para la Facultad de Ingenier¡a de la' );\r
+ writeln( ' Universidad de Buenos Aires. Consultas, sugerencias y/o reprobaciones a:' );\r
+ writeln;\r
+ textcolor( LightMagenta );\r
+ write( ' lluca@cnba.uba.ar' );\r
+ NormVideo;\r
+ write( ' o ' );\r
+ textcolor( LightMagenta );\r
+ writeln( 'lluca@geocities.com' );\r
+ NormVideo;\r
+ writeln;\r
+ writeln( ' (c) 1999 - Todos los derechos reservados.' );\r
+ delay( 750 );\r
+ end;\r
+\r
+(*********************************************************)\r
+\r
+var { programa }\r
+ datos: TABLA;\r
+ arch: text;\r
+ tecla: char;\r
+ salir: boolean;\r
+\r
+begin\r
+ randomize;\r
+ assign( arch, 'DATOS.TXT' );\r
+ salir := false;\r
+ textbackground( Blue );\r
+\r
+ while not salir do\r
+ begin\r
+ clrscr;\r
+ textcolor( Yellow );\r
+ gotoxy( 19, 3 );\r
+ writeln( 'COMPARACION DE ALGORITMOS DE ORDENAMIENTO' );\r
+ gotoxy( 19, 4 );\r
+ writeln( '~~~~~~~~~~~ ~~ ~~~~~~~~~~ ~~ ~~~~~~~~~~~~' );\r
+ gotoxy( 1, 7 );\r
+ textcolor( LightCyan );\r
+ writeln( ' Men£ Principal:' );\r
+ writeln( ' ---- ---------' );\r
+ textcolor( LightGray );\r
+ writeln;\r
+ writeln;\r
+ writeln( ' 1.- Generar Archivo (''DATOS.TXT'').' );\r
+ writeln( ' 2.- Evaluar Algoritmos.' );\r
+ writeln( ' 0.- Salir.' );\r
+ gotoxy( 1, 20 );\r
+ textcolor( White );\r
+ write( ' Ingrese su opci¢n: ' );\r
+ textcolor( Yellow );\r
+ tecla := readkey;\r
+ while ( ( tecla < '1' ) or ( tecla > '2' ) ) and ( tecla <> '0' ) do\r
+ begin\r
+ textcolor( White );\r
+ gotoxy( 1, 20 );\r
+ write( ' Ingrese su opci¢n (1, 2 o 0): ' );\r
+ textcolor( Yellow );\r
+ tecla := readkey;\r
+ end;\r
+ case tecla of\r
+ '1': MenuGenerar( arch );\r
+ '2': MenuEvaluar( datos, arch );\r
+ '0': salir := true;\r
+ end;\r
+ end;\r
+ PantallaSalida;\r
+end.
\ No newline at end of file
--- /dev/null
+program Comparacion_De_Algoritmos_De_Ordenamiento;\r
+\r
+uses\r
+ CRT, DOS;\r
+\r
+const\r
+ MAX_APE = 15;\r
+ RETARDO = 50;\r
+ VERSION = '1.2.8';\r
+\r
+type\r
+ APELLIDO = string[MAX_APE];\r
+ DOCUMENTO = longint;\r
+ PERSONA = record\r
+ ap: APELLIDO;\r
+ dni: DOCUMENTO;\r
+ end;\r
+ TABLA = array[1..1000] of PERSONA;\r
+\r
+(*********************************************************)\r
+\r
+ procedure CargarArchivo( var datos: TABLA; var ar: text; tam: integer );\r
+\r
+ var\r
+ i: integer;\r
+\r
+ begin\r
+ for i:= 1 to tam do\r
+ begin\r
+ writeln( ar, datos[i].ap );\r
+ writeln( ar, datos[i].dni );\r
+ writeln( ar );\r
+ end;\r
+ end; { procedure CargarArchivo }\r
+\r
+(*********************************************************)\r
+\r
+ procedure Retardar( centenas: longint );\r
+\r
+ var\r
+ i: integer;\r
+\r
+ begin\r
+ for i:= 1 to centenas * 100 do ;\r
+ end; { procedure Retardar }\r
+\r
+(*********************************************************)\r
+(*********************************************************)\r
+\r
+ procedure MenuEvaluar( var datos: TABLA; var arch: text );\r
+\r
+ type\r
+ HORA = record\r
+ h,\r
+ m,\r
+ s,\r
+ c: longint;\r
+ end;\r
+ ORDEN = ( CRECIENTE, DECRECIENTE );\r
+ MEDICION = record\r
+ Comp,\r
+ Int,\r
+ Tiem: longint;\r
+ end;\r
+ var\r
+ bs, bsm, shs, rs, ss, is, sls, slsm, qs: MEDICION;\r
+\r
+ (*********************************************************)\r
+\r
+ procedure CrearInforme( ord: ORDEN );\r
+\r
+ (*********************************************************)\r
+\r
+ procedure InfMetodo( var info: text; metodo: string; sort: MEDICION );\r
+\r
+ begin\r
+ writeln( info );\r
+ writeln( info, metodo, ':' );\r
+ writeln( info, ' Comparaciones: ', sort.Comp: 1 );\r
+ writeln( info, ' Intercambios: ', sort.Int div 3: 1, ' (', sort.Int: 1, ' asignaciones)' );\r
+ writeln( info, ' Tiempo (seg): ', sort.Tiem / 100: 2: 2 );\r
+ end; { procedure InfMetodo }\r
+\r
+ (*********************************************************)\r
+\r
+ var { procedure CrearInforme }\r
+ info: text;\r
+\r
+ begin\r
+ assign( info, 'INFORME.TXT' );\r
+ rewrite( info );\r
+ writeln( info );\r
+ if ord = DECRECIENTE then\r
+ begin\r
+ writeln( info, 'INFORME: Orden Decreciente.' );\r
+ writeln( info, '======= ~~~~~ ~~~~~~~~~~~' );\r
+ end\r
+ else\r
+ begin\r
+ writeln( info, 'INFORME: Orden Creciente.' );\r
+ writeln( info, '======= ~~~~~ ~~~~~~~~~' );\r
+ end;\r
+ writeln( info );\r
+ InfMetodo( info, 'Bubble Sort', bs );\r
+ InfMetodo( info, 'Bubble Sort Mejorado', bsm );\r
+ InfMetodo( info, 'Shake Sort', shs );\r
+ InfMetodo( info, 'Ripple Sort', rs );\r
+ InfMetodo( info, 'Selection Sort', ss );\r
+ InfMetodo( info, 'Insertion Sort', is );\r
+ InfMetodo( info, 'Shell''s Sort', sls );\r
+ InfMetodo( info, 'Shell''s Sort Mejorado', slsm );\r
+ InfMetodo( info, 'Quick Sort', qs );\r
+ writeln( info );\r
+ writeln( info );\r
+ writeln( info, 'NOTA: La cantidad de intercambios medida se tom¢ a partir de la cantidad de' );\r
+ writeln( info, '==== asignaciones, ya que en el Insertion Sort no hay intercambios. De esta' );\r
+ writeln( info, ' manera, un intercambio equivales a 3 asignaciones.' );\r
+ close( info );\r
+ end; { procedure CrearInforme }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure NoExisteArch;\r
+\r
+ begin\r
+ clrscr;\r
+ gotoxy( 20, 10 );\r
+ textcolor( LightMagenta + Blink );\r
+ writeln( 'ERROR: No existe el archivo a evaluar!' );\r
+ textcolor( LightGray );\r
+ writeln;\r
+ writeln( ' Creelo seleccionando la opci¢n 1 del Men£ Principal.' );\r
+ delay( 4000 );\r
+ end; { procedure NoExisteArch }\r
+\r
+ (*********************************************************)\r
+\r
+ function ExisteArchivo( nombre: String ): boolean;\r
+\r
+ { funcion extrida de la ayuda del Turbo Pascal 7 }\r
+\r
+ var\r
+ arch: text;\r
+\r
+ begin\r
+ {$I-}\r
+ Assign( arch, nombre );\r
+ FileMode := 0; { Solo lectura }\r
+ Reset( arch );\r
+ Close( arch );\r
+ {$I+}\r
+ ExisteArchivo := (IOResult = 0) and (nombre <> '');\r
+ end; { function ExisteArchivo }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure CargarTabla( var ar: text; var datos: TABLA; tam: integer );\r
+\r
+ var\r
+ i: integer;\r
+ void: string[2];\r
+\r
+ begin\r
+ for i:= 1 to tam do\r
+ begin\r
+ readln( ar, datos[i].ap );\r
+ readln( ar, datos[i].dni );\r
+ readln( ar, void );\r
+ end;\r
+ end; { procedure CargarTabla }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure Intercambiar( var a, b: PERSONA; var int: longint );\r
+\r
+ var\r
+ aux: PERSONA;\r
+\r
+ begin\r
+ int := int + 1;\r
+ Retardar( RETARDO );\r
+ aux := a;\r
+ int := int + 1;\r
+ Retardar( RETARDO );\r
+ a := b;\r
+ int := int + 1;\r
+ Retardar( RETARDO );\r
+ b := aux;\r
+ end; { procedure Intercambiar }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure GetHora( var hor: HORA );\r
+\r
+ var\r
+ h, m, s, c: word;\r
+\r
+ begin\r
+ gettime( h, m, s, c );\r
+ hor.h := h;\r
+ hor.m := m;\r
+ hor.s := s;\r
+ hor.c := c;\r
+ end; { procedure GetHora }\r
+\r
+ (*********************************************************)\r
+\r
+ function GetTiempo( h1, h2: HORA ): longint;\r
+\r
+ var\r
+ t: longint;\r
+ aux: HORA;\r
+\r
+ begin\r
+ if h1.h <> h2.h then { pone al menor como h2 y al mayor como h1 }\r
+ begin\r
+ if h1.h < h2.h then\r
+ begin\r
+ aux := h1;\r
+ h1 := h2;\r
+ h2 := aux;\r
+ end\r
+ end\r
+ else if h1.m <> h2.m then\r
+ begin\r
+ if h1.m < h2.m then\r
+ begin\r
+ aux := h1;\r
+ h1 := h2;\r
+ h2 := aux;\r
+ end\r
+ end\r
+ else if h1.s <> h2.s then\r
+ begin\r
+ if h1.s < h2.s then\r
+ begin\r
+ aux := h1;\r
+ h1 := h2;\r
+ h2 := aux;\r
+ end\r
+ end\r
+ else if h1.c <> h2.c then\r
+ if h1.c < h2.c then\r
+ begin\r
+ aux := h1;\r
+ h1 := h2;\r
+ h2 := aux;\r
+ end;\r
+ t := ( ( ( h1.h - h2.h ) * 60 + ( h1.m - h2.m ) ) * 60 + ( h1.s - h2.s ) ) * 100 + ( h1.c - h2.c );\r
+ GetTiempo := t;\r
+ end; { function GetTiempo }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure EvaluarCre( var datos: TABLA; var arch: text );\r
+\r
+ (*********************************************************)\r
+\r
+ procedure BubbleSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION );\r
+\r
+ var\r
+ i, j: integer;\r
+ h1, h2: HORA;\r
+\r
+ begin\r
+ GetHora( h1 );\r
+ m.Comp := 0;\r
+ m.Int := 0;\r
+ reset( arch );\r
+ CargarTabla( arch, datos, 1000 );\r
+ close( arch );\r
+ for i := tam - 1 downto 1 do\r
+ begin\r
+ for j := tam - 1 downto 1 do\r
+ begin\r
+ m.Comp := m.Comp + 1;\r
+ Retardar( RETARDO );\r
+ if datos[j].ap > datos[j+1].ap then\r
+ Intercambiar( datos[j], datos[j+1], m.Int);\r
+ end;\r
+ end;\r
+ GetHora( h2 );\r
+ m.Tiem := GetTiempo( h1, h2 );\r
+ end; { procedure BubbleSort }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure BubbleSortMej( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION );\r
+\r
+ var\r
+ huboint: boolean;\r
+ i, n: integer;\r
+ h1, h2: HORA;\r
+\r
+ begin\r
+ GetHora( h1 );\r
+ m.Comp := 0;\r
+ m.Int := 0;\r
+ n := 1;\r
+ reset( arch );\r
+ CargarTabla( arch, datos, 1000 );\r
+ close( arch );\r
+ huboint := true;\r
+ while huboint do\r
+ begin\r
+ huboint := false;\r
+ for i := tam - 1 downto n do\r
+ begin\r
+ m.Comp := m.Comp + 1;\r
+ Retardar( RETARDO );\r
+ if datos[i].ap > datos[i+1].ap then\r
+ begin\r
+ Intercambiar( datos[i], datos[i+1], m.Int);\r
+ huboint := true;\r
+ end;\r
+ end;\r
+ n := n + 1;\r
+ end;\r
+ GetHora( h2 );\r
+ m.Tiem := GetTiempo( h1, h2 );\r
+ end; { procedure BubbleSortMej }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure ShakeSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION );\r
+ var\r
+ h1, h2: HORA;\r
+ i, d, j, tmp: integer;\r
+\r
+ begin\r
+ GetHora( h1 );\r
+ m.Comp := 0;\r
+ m.Int := 0;\r
+ reset( arch );\r
+ CargarTabla( arch, datos, 1000 );\r
+ close( arch );\r
+ i := 2;\r
+ d := tam;\r
+ tmp := tam;\r
+ repeat\r
+ for j := d downto i do\r
+ begin\r
+ m.Comp := m.Comp + 1;\r
+ Retardar( RETARDO );\r
+ if datos[j].ap < datos[j-1].ap then\r
+ begin\r
+ Intercambiar( datos[j], datos[j-1], m.Int );\r
+ tmp := j;\r
+ end;\r
+ end;\r
+ i := tmp + 1;\r
+ for j := i to d do\r
+ begin\r
+ m.Comp := m.Comp + 1;\r
+ Retardar( RETARDO );\r
+ if datos[j].ap < datos[j-1].ap then\r
+ begin\r
+ Intercambiar( datos[j], datos[j-1], m.Int );\r
+ tmp := j;\r
+ end;\r
+ end;\r
+ d := tmp - 1;\r
+ until i >= d;\r
+ GetHora( h2 );\r
+ m.Tiem := GetTiempo( h1, h2 );\r
+ end; { procedure ShakeSort }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure RippleSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION );\r
+ var\r
+ h1, h2: HORA;\r
+ i, j: integer;\r
+\r
+ begin\r
+ GetHora( h1 );\r
+ m.Comp := 0;\r
+ m.Int := 0;\r
+ reset( arch );\r
+ CargarTabla( arch, datos, 1000 );\r
+ close( arch );\r
+ for i := 1 to tam do\r
+ begin\r
+ for j := i + 1 to tam do\r
+ begin\r
+ m.Comp := m.Comp + 1;\r
+ Retardar( RETARDO );\r
+ if datos[i].ap > datos[j].ap then Intercambiar( datos[i], datos[j], m.Int );\r
+ end;\r
+ end;\r
+ GetHora( h2 );\r
+ m.Tiem := GetTiempo( h1, h2 );\r
+ end; { procedure RippleSort }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure SelectionSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION );\r
+ var\r
+ i, sel, n: integer;\r
+ hubosel: boolean;\r
+ h1, h2: HORA;\r
+\r
+ begin\r
+ GetHora( h1 );\r
+ m.Comp := 0;\r
+ m.Int := 0;\r
+ reset( arch );\r
+ CargarTabla( arch, datos, 1000 );\r
+ close( arch );\r
+ for n := 1 to tam - 1 do\r
+ begin\r
+ hubosel := false;\r
+ sel := n;\r
+ for i := n + 1 to tam do\r
+ begin\r
+ m.Comp := m.Comp + 1;\r
+ Retardar( RETARDO );\r
+ if datos[sel].ap > datos[i].ap then\r
+ begin\r
+ sel := i;\r
+ hubosel := true;\r
+ end;\r
+ end;\r
+ if hubosel then Intercambiar( datos[n], datos[sel], m.Int);\r
+ end;\r
+ GetHora( h2 );\r
+ m.Tiem := GetTiempo( h1, h2 );\r
+ end; { procedure SelectionSort }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure InsertionSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION );\r
+ var\r
+ h1, h2: HORA;\r
+ i, j, k: integer;\r
+ tmp: PERSONA;\r
+ terminar: boolean;\r
+\r
+ begin\r
+ GetHora( h1 );\r
+ m.Comp := 0;\r
+ m.Int := 0;\r
+ reset( arch );\r
+ CargarTabla( arch, datos, 1000 );\r
+ close( arch );\r
+ for i := 2 to tam do\r
+ begin\r
+ m.Int := m.Int + 1;\r
+ Retardar( RETARDO );\r
+ tmp := datos[i];\r
+ j := i - 1;\r
+ terminar := false;\r
+ while ( j >= 1 ) and ( not terminar ) do\r
+ begin\r
+ m.Comp := m.Comp + 1;\r
+ Retardar( RETARDO );\r
+ if ( tmp.ap < datos[j].ap ) then\r
+ begin\r
+ m.Int := m.Int + 1;\r
+ Retardar( RETARDO );\r
+ datos[j+1] := datos[j];\r
+ j := j - 1;\r
+ end\r
+ else terminar := true;\r
+ end;\r
+ m.Int := m.Int + 1;\r
+ Retardar( RETARDO );\r
+ datos[j+1] := tmp;\r
+ end;\r
+ GetHora( h2 );\r
+ m.Tiem := GetTiempo( h1, h2 );\r
+ end; { procedure InsertionSort }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure ShellSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION );\r
+ var\r
+ h1, h2: HORA;\r
+ hueco, i, j: integer;\r
+ huboint: boolean;\r
+\r
+ begin\r
+ GetHora( h1 );\r
+ m.Comp := 0;\r
+ m.Int := 0;\r
+ reset( arch );\r
+ CargarTabla( arch, datos, 1000 );\r
+ close( arch );\r
+ hueco := tam;\r
+ while hueco > 1 do\r
+ begin\r
+ hueco := hueco div 2;\r
+ huboint := true;\r
+ while huboint do\r
+ begin\r
+ huboint := false;\r
+ for i := 1 to tam - hueco do\r
+ begin\r
+ j := i + hueco;\r
+ m.Comp := m.Comp + 1;\r
+ Retardar( RETARDO );\r
+ if ( datos[i].ap > datos[j].ap ) then\r
+ begin\r
+ Intercambiar( datos[i], datos[j], m.Int );\r
+ huboint := true;\r
+ end;\r
+ end;\r
+ end;\r
+ end;\r
+ GetHora( h2 );\r
+ m.Tiem := GetTiempo( h1, h2 );\r
+ end; { procedure ShellSort }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure ShellSortMej( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION );\r
+\r
+ (*********************************************************)\r
+\r
+ procedure Shell( var datos: TABLA; hueco, i: integer; var comp, int: longint );\r
+ var\r
+ j: integer;\r
+\r
+ begin\r
+ j := i + hueco;\r
+ comp := comp + 1;\r
+ Retardar( RETARDO );\r
+ if ( datos[i].ap > datos[j].ap ) then\r
+ begin\r
+ Intercambiar( datos[i], datos[j], int );\r
+ if (i - hueco) > 0 then\r
+ Shell( datos, hueco, i - hueco, comp, int );\r
+ end;\r
+ end; { procedure Shell }\r
+\r
+ (*********************************************************)\r
+\r
+ var { procedure ShellSortMej }\r
+ h1, h2: HORA;\r
+ hueco, i, j: integer;\r
+\r
+ begin\r
+ GetHora( h1 );\r
+ m.Comp := 0;\r
+ m.Int := 0;\r
+ reset( arch );\r
+ CargarTabla( arch, datos, 1000 );\r
+ close( arch );\r
+ hueco := tam;\r
+ while hueco > 1 do\r
+ begin\r
+ hueco := hueco div 2;\r
+ for i := 1 to tam - hueco do\r
+ begin\r
+ j := i + hueco;\r
+ m.Comp := m.Comp + 1;\r
+ Retardar( RETARDO );\r
+ if ( datos[i].ap > datos[j].ap ) then\r
+ begin\r
+ Intercambiar( datos[i], datos[j], m.Int );\r
+ if (i - hueco) > 0 then\r
+ Shell( datos, hueco, i - hueco, m.Comp, m.Int );\r
+ end;\r
+ end;\r
+ end;\r
+ GetHora( h2 );\r
+ m.Tiem := GetTiempo( h1, h2 );\r
+ end; { procedure ShellSortMej }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure QuickSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION );\r
+\r
+ (*********************************************************)\r
+\r
+ procedure QSort( var datos: TABLA; min, max: integer; var comp, int: longint );\r
+\r
+ var\r
+ i, j: integer;\r
+ sel: PERSONA;\r
+ flag: boolean;\r
+\r
+ begin\r
+ sel := datos[( min + max ) div 2];\r
+ i := min;\r
+ j := max;\r
+ repeat\r
+ comp := comp + 1;\r
+ Retardar( RETARDO );\r
+ flag := false;\r
+ while datos[i].ap < sel.ap do\r
+ begin\r
+ if flag then begin\r
+ comp := comp + 1;\r
+ Retardar( RETARDO );\r
+ end\r
+ else flag := true;\r
+ i := i + 1;\r
+ end;\r
+ comp := comp + 1;\r
+ Retardar( RETARDO );\r
+ flag := false;\r
+ while datos[j].ap > sel.ap do\r
+ begin\r
+ if flag then begin\r
+ comp := comp + 1;\r
+ Retardar( RETARDO );\r
+ end\r
+ else flag := true;\r
+ j := j - 1;\r
+ end;\r
+ if i <= j then\r
+ begin\r
+ if i < j then Intercambiar( datos[i], datos[j], int );\r
+ i := i + 1;\r
+ j := j - 1;\r
+ end;\r
+ until i > j;\r
+ if min < j then QSort( datos, min, j, comp, int);\r
+ if i < max then QSort( datos, i, max, comp, int);\r
+ end; { procedure QSort }\r
+\r
+ (*********************************************************)\r
+\r
+ var\r
+ h1, h2: HORA;\r
+\r
+ begin { procedure QuickSort }\r
+ GetHora( h1 );\r
+ m.Comp := 0;\r
+ m.Int := 0;\r
+ reset( arch );\r
+ CargarTabla( arch, datos, 1000 );\r
+ close( arch );\r
+ QSort( datos, 1, 1000, m.Comp, m.Int );\r
+ GetHora( h2 );\r
+ m.Tiem := GetTiempo( h1, h2 );\r
+ end; { procedure QuickSort }\r
+\r
+ (*********************************************************)\r
+\r
+ begin { procedure EvaluarCre }\r
+ if ExisteArchivo( 'DATOS.TXT' ) then\r
+ begin\r
+ BubbleSort( arch, datos, 1000, bs );\r
+ BubbleSortMej( arch, datos, 1000, bsm );\r
+ ShakeSort( arch, datos, 1000, shs );\r
+ RippleSort( arch, datos, 1000, rs );\r
+ SelectionSort( arch, datos, 1000, ss );\r
+ InsertionSort( arch, datos, 1000, is );\r
+ ShellSort( arch, datos, 1000, sls );\r
+ ShellSortMej( arch, datos, 1000, slsm );\r
+ QuickSort( arch, datos, 1000, qs );\r
+ CrearInforme( CRECIENTE );\r
+ end\r
+ else\r
+ NoExisteArch;\r
+ end; { procedure EvaluarCre }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure EvaluarDec( var datos: TABLA; var arch: text );\r
+\r
+ (*********************************************************)\r
+\r
+ procedure BubbleSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION );\r
+\r
+ var\r
+ i, j: integer;\r
+ h1, h2: HORA;\r
+\r
+ begin\r
+ GetHora( h1 );\r
+ m.Comp := 0;\r
+ m.Int := 0;\r
+ reset( arch );\r
+ CargarTabla( arch, datos, 1000 );\r
+ close( arch );\r
+ for i := tam - 1 downto 1 do\r
+ begin\r
+ for j := tam - 1 downto 1 do\r
+ begin\r
+ m.Comp := m.Comp + 1;\r
+ Retardar( RETARDO );\r
+ if datos[j].ap < datos[j+1].ap then\r
+ Intercambiar( datos[j], datos[j+1], m.Int);\r
+ end;\r
+ end;\r
+ GetHora( h2 );\r
+ m.Tiem := GetTiempo( h1, h2 );\r
+ end; { procedure BubbleSort }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure BubbleSortMej( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION );\r
+\r
+ var\r
+ huboint: boolean;\r
+ i, n: integer;\r
+ h1, h2: HORA;\r
+\r
+ begin\r
+ GetHora( h1 );\r
+ m.Comp := 0;\r
+ m.Int := 0;\r
+ n := 1;\r
+ reset( arch );\r
+ CargarTabla( arch, datos, 1000 );\r
+ close( arch );\r
+ huboint := true;\r
+ while huboint do\r
+ begin\r
+ huboint := false;\r
+ for i := tam - 1 downto n do\r
+ begin\r
+ m.Comp := m.Comp + 1;\r
+ Retardar( RETARDO );\r
+ if datos[i].ap < datos[i+1].ap then\r
+ begin\r
+ Intercambiar( datos[i], datos[i+1], m.Int);\r
+ huboint := true;\r
+ end;\r
+ end;\r
+ n := n + 1;\r
+ end;\r
+ GetHora( h2 );\r
+ m.Tiem := GetTiempo( h1, h2 );\r
+ end; { procedure BubbleSortMej }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure ShakeSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION );\r
+ var\r
+ h1, h2: HORA;\r
+ i, d, j, tmp: integer;\r
+\r
+ begin\r
+ GetHora( h1 );\r
+ m.Comp := 0;\r
+ m.Int := 0;\r
+ reset( arch );\r
+ CargarTabla( arch, datos, 1000 );\r
+ close( arch );\r
+ i := 2;\r
+ d := tam;\r
+ tmp := tam;\r
+ repeat\r
+ for j := d downto i do\r
+ begin\r
+ m.Comp := m.Comp + 1;\r
+ Retardar( RETARDO );\r
+ if datos[j].ap > datos[j-1].ap then\r
+ begin\r
+ Intercambiar( datos[j], datos[j-1], m.Int );\r
+ tmp := j;\r
+ end;\r
+ end;\r
+ i := tmp + 1;\r
+ for j := i to d do\r
+ begin\r
+ m.Comp := m.Comp + 1;\r
+ Retardar( RETARDO );\r
+ if datos[j].ap > datos[j-1].ap then\r
+ begin\r
+ Intercambiar( datos[j], datos[j-1], m.Int );\r
+ tmp := j;\r
+ end;\r
+ end;\r
+ d := tmp - 1;\r
+ until i >= d;\r
+ GetHora( h2 );\r
+ m.Tiem := GetTiempo( h1, h2 );\r
+ end; { procedure ShakeSort }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure RippleSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION );\r
+ var\r
+ h1, h2: HORA;\r
+ i, j: integer;\r
+\r
+ begin\r
+ GetHora( h1 );\r
+ m.Comp := 0;\r
+ m.Int := 0;\r
+ reset( arch );\r
+ CargarTabla( arch, datos, 1000 );\r
+ close( arch );\r
+ for i := 1 to tam do\r
+ begin\r
+ for j := i + 1 to tam do\r
+ begin\r
+ m.Comp := m.Comp + 1;\r
+ Retardar( RETARDO );\r
+ if datos[i].ap < datos[j].ap then Intercambiar( datos[i], datos[j], m.Int );\r
+ end;\r
+ end;\r
+ GetHora( h2 );\r
+ m.Tiem := GetTiempo( h1, h2 );\r
+ end; { procedure RippleSort }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure SelectionSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION );\r
+ var\r
+ i, sel, n: integer;\r
+ hubosel: boolean;\r
+ h1, h2: HORA;\r
+\r
+ begin\r
+ GetHora( h1 );\r
+ m.Comp := 0;\r
+ m.Int := 0;\r
+ reset( arch );\r
+ CargarTabla( arch, datos, 1000 );\r
+ close( arch );\r
+ for n := 1 to tam - 1 do\r
+ begin\r
+ hubosel := false;\r
+ sel := n;\r
+ for i := n + 1 to tam do\r
+ begin\r
+ m.Comp := m.Comp + 1;\r
+ Retardar( RETARDO );\r
+ if datos[sel].ap < datos[i].ap then\r
+ begin\r
+ sel := i;\r
+ hubosel := true;\r
+ end;\r
+ end;\r
+ if hubosel then Intercambiar( datos[n], datos[sel], m.Int);\r
+ end;\r
+ GetHora( h2 );\r
+ m.Tiem := GetTiempo( h1, h2 );\r
+ end; { procedure SelectionSort }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure InsertionSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION );\r
+ var\r
+ h1, h2: HORA;\r
+ i, j, k: integer;\r
+ tmp: PERSONA;\r
+ terminar: boolean;\r
+\r
+ begin\r
+ GetHora( h1 );\r
+ m.Comp := 0;\r
+ m.Int := 0;\r
+ reset( arch );\r
+ CargarTabla( arch, datos, 1000 );\r
+ close( arch );\r
+ for i := 2 to tam do\r
+ begin\r
+ m.Int := m.Int + 1;\r
+ Retardar( RETARDO );\r
+ tmp := datos[i];\r
+ j := i - 1;\r
+ terminar := false;\r
+ while ( j >= 1 ) and ( not terminar ) do\r
+ begin\r
+ m.Comp := m.Comp + 1;\r
+ Retardar( RETARDO );\r
+ if ( tmp.ap > datos[j].ap ) then\r
+ begin\r
+ m.Int := m.Int + 1;\r
+ Retardar( RETARDO );\r
+ datos[j+1] := datos[j];\r
+ j := j - 1;\r
+ end\r
+ else terminar := true;\r
+ end;\r
+ m.Int := m.Int + 1;\r
+ Retardar( RETARDO );\r
+ datos[j+1] := tmp;\r
+ end;\r
+ GetHora( h2 );\r
+ m.Tiem := GetTiempo( h1, h2 );\r
+ end; { procedure InsertionSort }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure ShellSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION );\r
+ var\r
+ h1, h2: HORA;\r
+ hueco, i, j: integer;\r
+ huboint: boolean;\r
+\r
+ begin\r
+ GetHora( h1 );\r
+ m.Comp := 0;\r
+ m.Int := 0;\r
+ reset( arch );\r
+ CargarTabla( arch, datos, 1000 );\r
+ close( arch );\r
+ hueco := tam;\r
+ while hueco > 1 do\r
+ begin\r
+ hueco := hueco div 2;\r
+ huboint := true;\r
+ while huboint do\r
+ begin\r
+ huboint := false;\r
+ for i := 1 to tam - hueco do\r
+ begin\r
+ j := i + hueco;\r
+ m.Comp := m.Comp + 1;\r
+ Retardar( RETARDO );\r
+ if ( datos[i].ap < datos[j].ap ) then\r
+ begin\r
+ Intercambiar( datos[i], datos[j], m.Int );\r
+ huboint := true;\r
+ end;\r
+ end;\r
+ end;\r
+ end;\r
+ GetHora( h2 );\r
+ m.Tiem := GetTiempo( h1, h2 );\r
+ end; { procedure ShellSort }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure ShellSortMej( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION );\r
+\r
+ (*********************************************************)\r
+\r
+ procedure Shell( var datos: TABLA; hueco, i: integer;\r
+ var comp: longint; var int: longint );\r
+ var\r
+ j: integer;\r
+\r
+ begin\r
+ j := i + hueco;\r
+ comp := comp + 1;\r
+ Retardar( RETARDO );\r
+ if ( datos[i].ap < datos[j].ap ) then\r
+ begin\r
+ Intercambiar( datos[i], datos[j], int );\r
+ if (i - hueco) > 0 then\r
+ Shell( datos, hueco, i - hueco, comp, int );\r
+ end;\r
+ end; { procedure Shell }\r
+\r
+ (*********************************************************)\r
+\r
+ var { procedure ShellSortMej }\r
+ h1, h2: HORA;\r
+ hueco, i, j: integer;\r
+\r
+ begin\r
+ GetHora( h1 );\r
+ m.Comp := 0;\r
+ m.Int := 0;\r
+ reset( arch );\r
+ CargarTabla( arch, datos, 1000 );\r
+ close( arch );\r
+ hueco := tam;\r
+ while hueco > 1 do\r
+ begin\r
+ hueco := hueco div 2;\r
+ for i := 1 to tam - hueco do\r
+ begin\r
+ j := i + hueco;\r
+ m.Comp := m.Comp + 1;\r
+ Retardar( RETARDO );\r
+ if ( datos[i].ap < datos[j].ap ) then\r
+ begin\r
+ Intercambiar( datos[i], datos[j], m.Int );\r
+ if (i - hueco) > 0 then\r
+ Shell( datos, hueco, i - hueco, m.Comp, m.Int );\r
+ end;\r
+ end;\r
+ end;\r
+ GetHora( h2 );\r
+ m.Tiem := GetTiempo( h1, h2 );\r
+ end; { procedure ShellSortMej }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure QuickSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION );\r
+\r
+ procedure QSort( var datos: TABLA; min, max: integer;\r
+ var comp: longint; var int: longint );\r
+\r
+ var\r
+ i, j: integer;\r
+ sel: PERSONA;\r
+ flag: boolean;\r
+\r
+ begin\r
+ sel := datos[( min + max ) div 2];\r
+ i := min;\r
+ j := max;\r
+ repeat\r
+ comp := comp + 1;\r
+ Retardar( RETARDO );\r
+ flag := false;\r
+ while datos[i].ap > sel.ap do\r
+ begin\r
+ if flag then begin\r
+ comp := comp + 1;\r
+ Retardar( RETARDO );\r
+ end\r
+ else flag := true;\r
+ i := i + 1;\r
+ end;\r
+ comp := comp + 1;\r
+ Retardar( RETARDO );\r
+ flag := false;\r
+ while datos[j].ap < sel.ap do\r
+ begin\r
+ if flag then begin\r
+ comp := comp + 1;\r
+ Retardar( RETARDO );\r
+ end\r
+ else flag := true;\r
+ j := j - 1;\r
+ end;\r
+ if i <= j then\r
+ begin\r
+ if i < j then Intercambiar( datos[i], datos[j], int );\r
+ i := i + 1;\r
+ j := j - 1;\r
+ end;\r
+ until i > j;\r
+ if min < j then QSort( datos, min, j, comp, int);\r
+ if i < max then QSort( datos, i, max, comp, int);\r
+ end; { procedure QSort }\r
+\r
+ (*********************************************************)\r
+\r
+ var\r
+ h1, h2: HORA;\r
+\r
+ begin { procedure QuickSort }\r
+ GetHora( h1 );\r
+ m.Comp := 0;\r
+ m.Int := 0;\r
+ reset( arch );\r
+ CargarTabla( arch, datos, 1000 );\r
+ close( arch );\r
+ QSort( datos, 1, 1000, m.Comp, m.Int );\r
+ GetHora( h2 );\r
+ m.Tiem := GetTiempo( h1, h2 );\r
+ end; { procedure QuickSort }\r
+\r
+ (*********************************************************)\r
+\r
+ begin { procedure EvaluarDec }\r
+ if ExisteArchivo( 'DATOS.TXT' ) then\r
+ begin\r
+ BubbleSort( arch, datos, 1000, bs );\r
+ BubbleSortMej( arch, datos, 1000, bsm );\r
+ ShakeSort( arch, datos, 1000, shs );\r
+ RippleSort( arch, datos, 1000, rs );\r
+ SelectionSort( arch, datos, 1000, ss );\r
+ InsertionSort( arch, datos, 1000, is );\r
+ ShellSort( arch, datos, 1000, sls );\r
+ ShellSortMej( arch, datos, 1000, slsm );\r
+ QuickSort( arch, datos, 1000, qs );\r
+ CrearInforme( DECRECIENTE );\r
+ end\r
+ else\r
+ NoExisteArch;\r
+ end; { procedure EvaluarDec }\r
+\r
+ (*********************************************************)\r
+\r
+ var { procedure MenuEvaluar }\r
+ tecla: char;\r
+\r
+ begin\r
+ clrscr;\r
+ textcolor( Yellow );\r
+ gotoxy( 19, 3 );\r
+ writeln( 'COMPARACION DE ALGORITMOS DE ORDENAMIENTO' );\r
+ gotoxy( 19, 4 );\r
+ writeln( '~~~~~~~~~~~ ~~ ~~~~~~~~~~ ~~ ~~~~~~~~~~~~' );\r
+ textcolor( LightCyan );\r
+ gotoxy( 1, 7 );\r
+ writeln( ' Evaluar Algoritmos:' );\r
+ writeln( ' ------- ----------' );\r
+ textcolor( LightGray );\r
+ writeln;\r
+ writeln;\r
+ writeln( ' 1.- Ordenando en forma creciente.' );\r
+ writeln( ' 2.- Ordenando en forma decreciente.' );\r
+ writeln( ' 0.- Men£ Anterior.' );\r
+ gotoxy( 1, 20 );\r
+ textcolor( White );\r
+ write( ' Ingrese su opci¢n: ' );\r
+ textcolor( Yellow );\r
+ tecla := readkey;\r
+ while ( ( tecla < '1' ) or ( tecla > '2' ) ) and ( tecla <> '0' ) do\r
+ begin\r
+ textcolor( White );\r
+ gotoxy( 1, 20 );\r
+ write( ' Ingrese su opci¢n (1, 2 o 0): ' );\r
+ textcolor( Yellow );\r
+ tecla := readkey;\r
+ end;\r
+ case tecla of\r
+ '1': if ExisteArchivo( 'DATOS.TXT' ) then EvaluarCre( datos, arch )\r
+ else NoExisteArch;\r
+ '2': if ExisteArchivo( 'DATOS.TXT' ) then EvaluarDec( datos, arch )\r
+ else NoExisteArch;\r
+ '0': ;\r
+ end;\r
+ end;\r
+\r
+(*********************************************************)\r
+(*********************************************************)\r
+\r
+ procedure MenuGenerar( var arch: text );\r
+\r
+ type\r
+ TIPO_LETRA = ( TL_VOCAL, TL_CONSO );\r
+ TIPO_VOCAL = ( TV_AEIOU, TV_EI );\r
+ INDICADOR = ( I_NADA, I_ESB, I_ESC, I_ESF, I_ESG, I_ESL, I_ESM, I_ESN, I_ESQ, I_ESQU, I_ESR, I_EST );\r
+\r
+ (*********************************************************)\r
+\r
+ function GetRNDApellido( max, min: integer ): APELLIDO;\r
+\r
+ (*********************************************************)\r
+\r
+ function GetVocal( tipo: TIPO_VOCAL ): char;\r
+\r
+ var\r
+ valor: integer;\r
+\r
+ begin\r
+ if tipo = TV_AEIOU then valor := random( 16 )\r
+ else valor := random( 6 ) + 5;\r
+ case valor of\r
+ 0..4: GetVocal := 'A';\r
+ 5..7: GetVocal := 'E';\r
+ 8..10: GetVocal := 'I';\r
+ 11..13: GetVocal := 'O';\r
+ 14..15: GetVocal := 'U';\r
+ end;\r
+ end; { function GetVocal }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure GetRNDVocal( var indic: INDICADOR; var proxl: TIPO_LETRA; var vocal: char );\r
+\r
+ var\r
+ valor: integer;\r
+\r
+ begin\r
+ case indic of\r
+ I_ESQ:\r
+ begin\r
+ vocal := 'U';\r
+ indic := I_ESQU;\r
+ proxl := TL_VOCAL;\r
+ end;\r
+ I_ESQU:\r
+ begin\r
+ vocal := GetVocal( TV_EI );\r
+ indic := I_NADA;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ else\r
+ begin\r
+ vocal := GetVocal( TV_AEIOU );\r
+ indic := I_NADA;\r
+ if random( 40 ) = 0 then proxl := TL_VOCAL\r
+ else proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ end; { procedure GetRNDVocal }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure GetRNDConsonante( var indic: INDICADOR; var proxl: TIPO_LETRA; var conso: char );\r
+\r
+ var\r
+ valor: integer;\r
+\r
+ begin\r
+ proxl := TL_VOCAL;\r
+ indic := I_NADA;\r
+\r
+ case indic of\r
+ I_ESF, I_ESR, I_ESG, I_EST: conso := 'R';\r
+ I_ESB: case random( 2 ) of\r
+ 0: conso := 'R';\r
+ 1: conso := 'L';\r
+ end;\r
+ I_ESC: case random( 4 ) of\r
+ 0: conso := 'C';\r
+ 1: conso := 'H';\r
+ 2: conso := 'R';\r
+ 3: conso := 'L';\r
+ end;\r
+ I_ESL: case random( 6 ) of\r
+ 0: conso := 'T';\r
+ 1..5: conso := 'L';\r
+ end;\r
+ I_ESM: case random( 3 ) of\r
+ 0: conso := 'P';\r
+ 1: conso := 'B';\r
+ 2: conso := 'L';\r
+ end;\r
+ I_ESN: case random( 3 ) of\r
+ 0: conso := 'R';\r
+ 1: conso := 'V';\r
+ 2: conso := 'C';\r
+ end;\r
+ else case random( 55 ) of\r
+ 0..3: begin\r
+ conso := 'B';\r
+ if random( 10 ) = 0 then begin\r
+ indic := I_ESB;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 4..7: begin\r
+ conso := 'C';\r
+ if random( 5 ) = 0 then begin\r
+ indic := I_ESC;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 8..11: conso := 'D';\r
+ 12..14: begin\r
+ conso := 'F';\r
+ if random( 10 ) = 0 then begin\r
+ indic := I_ESF;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 15..17: begin\r
+ conso := 'G';\r
+ if random( 5 ) = 0 then\r
+ begin\r
+ indic := I_ESG;\r
+ if random( 4 ) = 0 then proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 18..19: conso := 'H';\r
+ 20..22: conso := 'J';\r
+ 23..24: conso := 'K';\r
+ 25..27: begin\r
+ conso := 'L';\r
+ if random( 15 ) = 0 then\r
+ begin\r
+ indic := I_ESL;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 28..30: begin\r
+ conso := 'M';\r
+ if random( 5 ) = 0 then\r
+ begin\r
+ indic := I_ESM;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 31..33: begin\r
+ conso := 'N';\r
+ if random( 5 ) = 0 then\r
+ begin\r
+ indic := I_ESN;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 34..36: conso := 'P';\r
+ 37..38: begin\r
+ conso := 'Q';\r
+ indic := I_ESQ;\r
+ end;\r
+ 39..41: begin\r
+ conso := 'R';\r
+ if random( 3 ) = 0 then\r
+ begin\r
+ indic := I_ESR;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 42..44: conso := 'S';\r
+ 45..47: begin\r
+ conso := 'T';\r
+ if random( 10 ) = 0 then\r
+ begin\r
+ indic := I_EST;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 48..50: conso := 'V';\r
+ 51: conso := 'W';\r
+ 52: conso := 'X';\r
+ 53: conso := 'Y';\r
+ 54: conso := 'Z';\r
+ end; { case random( 55 ) of }\r
+\r
+ end; { case indic of }\r
+ end; { procedure GetRNDConsonante }\r
+\r
+ (*********************************************************)\r
+\r
+ var { function GetRNDApellido }\r
+ tam, i: integer;\r
+ aux: char;\r
+ apel: APELLIDO;\r
+ indic: INDICADOR;\r
+ proxl: TIPO_LETRA;\r
+\r
+ begin\r
+ if max > MAX_APE then max := MAX_APE;\r
+ tam := random( max + 1 ) + min;\r
+ indic := I_NADA;\r
+ apel := '';\r
+ if random( 5 ) = 0 then proxl := TL_VOCAL\r
+ else proxl := TL_CONSO;\r
+ for i := 1 to tam do\r
+ begin\r
+ if proxl = TL_CONSO then GetRNDConsonante( indic, proxl, aux )\r
+ else GetRNDVocal( indic, proxl, aux );\r
+ apel := apel + aux;\r
+ end;\r
+ GetRNDApellido := apel;\r
+ end; { function GetRNDApellido }\r
+\r
+ (*********************************************************)\r
+\r
+ function GetRNDLetra( min, max: char ): char;\r
+\r
+ begin\r
+ GetRNDLetra := chr( random( ord( max ) - ord( min ) + 1 ) + ord( min ) );\r
+ end;\r
+\r
+ (*********************************************************)\r
+\r
+ procedure GetOrdApellidos( var ar: text; cant: integer );\r
+\r
+ var\r
+ mil: boolean;\r
+ letra, letra1: char;\r
+ i, j, veces: integer;\r
+ dni: DOCUMENTO;\r
+ ap, ape, apel: APELLIDO;\r
+\r
+ begin\r
+ mil := false;\r
+ if cant = 1000 then mil := true;\r
+ dni := 10000000 + (random( 15000 ) * 100);\r
+ ap := '';\r
+ ape := '';\r
+ apel := '';\r
+ for letra := 'A' to 'Z' do\r
+ begin\r
+ ap := letra;\r
+ for letra1 := 'A' to 'Z' do\r
+ begin\r
+ if mil then\r
+ case letra of\r
+ 'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T':\r
+ case letra1 of\r
+ 'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T', 'Z': veces := 2;\r
+ else veces := 1;\r
+ end;\r
+ else case letra1 of\r
+ 'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T': veces := 2;\r
+ else veces := 1;\r
+ end;\r
+ end\r
+ else\r
+ case letra of\r
+ 'A', 'B', 'C', 'D', 'E', 'F', 'I', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T', 'V':\r
+ case letra1 of\r
+ 'D', 'F', 'G', 'H', 'I', 'J', 'K', 'U', 'V': veces := 2;\r
+ else veces := 1;\r
+ end;\r
+ else case letra1 of\r
+ 'D', 'F', 'G', 'H', 'I', 'J', 'K', 'U': veces := 2;\r
+ else veces := 1;\r
+ end;\r
+ end;\r
+ ape := ap + letra1;\r
+ for j := 1 to veces do\r
+ begin\r
+ if j = 1 then apel := ape + GetRNDLetra( 'A', 'M' ) + GetRNDApellido( 6, 1 )\r
+ else apel := ape + GetRNDLetra( 'N', 'Z' ) + GetRNDApellido( 6, 1 );\r
+ dni := dni + random( 50000 ) + 1;\r
+ writeln( ar, apel );\r
+ writeln( ar, dni );\r
+ writeln( ar );\r
+ apel := '';\r
+ end;\r
+\r
+ ape := '';\r
+\r
+ end; { for letra1 := 'A' to 'Z' do }\r
+\r
+ ap := '';\r
+\r
+ end; { for letra := 'A' to 'Z' do }\r
+\r
+ end; { procedure GetOrdApellidos }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure GetInvOrdApellidos( var ar: text; cant: integer );\r
+\r
+ var\r
+ mil: boolean;\r
+ letra, letra1: char;\r
+ i, j, veces: integer;\r
+ dni: DOCUMENTO;\r
+ ap, ape, apel: APELLIDO;\r
+\r
+ begin\r
+ mil := false;\r
+ if cant = 1000 then mil := true;\r
+ dni := 34000000 + (random( 15000 ) * 100);\r
+ ap := '';\r
+ ape := '';\r
+ apel := '';\r
+ for letra := 'Z' downto 'A' do\r
+ begin\r
+ ap := letra;\r
+ for letra1 := 'Z' downto 'A' do\r
+ begin\r
+ if mil then\r
+ case letra of\r
+ 'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T':\r
+ case letra1 of\r
+ 'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T', 'Z': veces := 2;\r
+ else veces := 1;\r
+ end;\r
+ else case letra1 of\r
+ 'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T': veces := 2;\r
+ else veces := 1;\r
+ end;\r
+ end\r
+ else\r
+ case letra of\r
+ 'A', 'B', 'C', 'D', 'E', 'F', 'I', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T', 'V':\r
+ case letra1 of\r
+ 'D', 'F', 'G', 'H', 'I', 'J', 'K', 'U', 'V': veces := 2;\r
+ else veces := 1;\r
+ end;\r
+ else case letra1 of\r
+ 'D', 'F', 'G', 'H', 'I', 'J', 'K', 'U': veces := 2;\r
+ else veces := 1;\r
+ end;\r
+ end;\r
+ ape := ap + letra1;\r
+ for j := 1 to veces do\r
+ begin\r
+ if j <> 1 then apel := ape + GetRNDLetra( 'A', 'M' ) + GetRNDApellido( 6, 1 )\r
+ else apel := ape + GetRNDLetra( 'N', 'Z' ) + GetRNDApellido( 6, 1 );\r
+ dni := dni - random( 40000 ) - 1;\r
+ writeln( ar, apel );\r
+ writeln( ar, dni );\r
+ writeln( ar );\r
+ apel := '';\r
+ end;\r
+\r
+ ape := '';\r
+\r
+ end; { for letra1 := 'A' to 'Z' do }\r
+\r
+ ap := '';\r
+\r
+ end; { for letra := 'A' to 'Z' do }\r
+\r
+ end; { GetInvOrdApellidos }\r
+\r
+\r
+ (*********************************************************)\r
+\r
+ procedure GenerarRND( var arch: text; n: integer; reabrir: boolean );\r
+\r
+ var\r
+ i: integer;\r
+ ap: APELLIDO;\r
+ dni: DOCUMENTO;\r
+\r
+ begin\r
+ if reabrir then rewrite( arch );\r
+ dni := 10000000 + (random( 15000 ) * 100);\r
+\r
+ for i := 1 to n do\r
+ begin\r
+ ap := GetRNDApellido( 8, 4 );\r
+ dni := dni + random( 50000 ) + 1;\r
+ writeln( arch, ap );\r
+ writeln( arch, dni );\r
+ writeln( arch );\r
+ end;\r
+ if reabrir then close( arch );\r
+ end; { procedure GenerarRND }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure GenerarOrd( var arch: text; n: integer; reabrir: boolean );\r
+\r
+ begin\r
+ if reabrir then rewrite( arch );\r
+ GetOrdApellidos( arch, n );\r
+ if reabrir then close( arch );\r
+ end;\r
+\r
+ (*********************************************************)\r
+\r
+ procedure GenerarOrdDec( var arch: text; n: integer; reabrir: boolean );\r
+\r
+ begin\r
+ if reabrir then rewrite( arch );\r
+ GetInvOrdApellidos( arch, n );\r
+ if reabrir then close( arch );\r
+ end;\r
+\r
+ (*********************************************************)\r
+\r
+ procedure Generar90Ord( var arch: text );\r
+\r
+ begin\r
+ rewrite( arch );\r
+ GenerarOrd( arch, 900, false );\r
+ GenerarRND( arch, 100, false );\r
+ close( arch );\r
+ end;\r
+\r
+ (*********************************************************)\r
+\r
+ procedure Generar90OrdDec( var arch: text );\r
+\r
+ begin\r
+ rewrite( arch );\r
+ GenerarOrdDec( arch, 900, false );\r
+ GenerarRND( arch, 100, false );\r
+ close( arch );\r
+ end;\r
+\r
+ (*********************************************************)\r
+\r
+ var { procedure MenuGenerar }\r
+ tecla: char;\r
+\r
+ begin\r
+ clrscr;\r
+ textcolor( Yellow );\r
+ gotoxy( 19, 3 );\r
+ writeln( 'COMPARACION DE ALGORITMOS DE ORDENAMIENTO' );\r
+ gotoxy( 19, 4 );\r
+ writeln( '~~~~~~~~~~~ ~~ ~~~~~~~~~~ ~~ ~~~~~~~~~~~~' );\r
+ textcolor( LightCyan );\r
+ gotoxy( 1, 7 );\r
+ writeln( ' Generar Archivo (''DATOS.TXT''):' );\r
+ writeln( ' ------- ------- -------------' );\r
+ textcolor( LightGray );\r
+ writeln;\r
+ writeln;\r
+ writeln( ' 1.- Con datos desordenados.' );\r
+ writeln( ' 2.- Con datos en orden creciente (APELLIDO, DNI).' );\r
+ writeln( ' 3.- Con datos en orden decreciente (APELLIDO, DNI).' );\r
+ writeln( ' 4.- Con 90% datos en orden creciente (APELLIDO, DNI) + 10% desordenado.' );\r
+ writeln( ' 5.- Con 90% datos en orden decreciente (APELLIDO, DNI) + 10% desordenado.' );\r
+ writeln( ' 0.- Men£ Anterior.' );\r
+ gotoxy( 1, 20 );\r
+ textcolor( White );\r
+ write( ' Ingrese su opci¢n: ' );\r
+ textcolor( Yellow );\r
+ tecla := readkey;\r
+ while ( ( tecla < '1' ) or ( tecla > '5' ) ) and ( tecla <> '0' ) do\r
+ begin\r
+ textcolor( White );\r
+ gotoxy( 1, 20 );\r
+ write( ' Ingrese su opci¢n (1 a 5 o 0): ' );\r
+ textcolor( Yellow );\r
+ tecla := readkey;\r
+ end;\r
+ case tecla of\r
+ '1': GenerarRND( arch, 1000, true );\r
+ '2': GenerarOrd( arch, 1000, true );\r
+ '3': GenerarOrdDec( arch, 1000, true );\r
+ '4': Generar90Ord( arch );\r
+ '5': Generar90OrdDec( arch );\r
+ '0': ;\r
+ end;\r
+ end; { procedure MenuGenerar }\r
+\r
+(*********************************************************)\r
+\r
+ procedure PantallaSalida;\r
+\r
+ begin\r
+ writeln;\r
+ NormVideo;\r
+ clrscr;\r
+ writeln;\r
+ textcolor( white );\r
+ writeln( ' COMPARACION DE ALGORITMOS DE ORDENAMIENTO versi¢n ', VERSION, ' <-o-o-> Luca - Soft' );\r
+ NormVideo;\r
+ writeln( ' Desarrollado por Leandro Lucarella para la Facultad de Ingenier¡a de la' );\r
+ writeln( ' Universidad de Buenos Aires. Consultas, sugerencias y/o reprobaciones a:' );\r
+ writeln;\r
+ textcolor( LightMagenta );\r
+ write( ' lluca@cnba.uba.ar' );\r
+ NormVideo;\r
+ write( ' o ' );\r
+ textcolor( LightMagenta );\r
+ writeln( 'lluca@geocities.com' );\r
+ NormVideo;\r
+ writeln;\r
+ writeln( ' (c) 1999 - Todos los derechos reservados.' );\r
+ delay( 750 );\r
+ end;\r
+\r
+(*********************************************************)\r
+\r
+var { programa }\r
+ datos: TABLA;\r
+ arch: text;\r
+ tecla: char;\r
+ salir: boolean;\r
+\r
+begin\r
+ randomize;\r
+ assign( arch, 'DATOS.TXT' );\r
+ salir := false;\r
+ textbackground( Blue );\r
+\r
+ while not salir do\r
+ begin\r
+ clrscr;\r
+ textcolor( Yellow );\r
+ gotoxy( 19, 3 );\r
+ writeln( 'COMPARACION DE ALGORITMOS DE ORDENAMIENTO' );\r
+ gotoxy( 19, 4 );\r
+ writeln( '~~~~~~~~~~~ ~~ ~~~~~~~~~~ ~~ ~~~~~~~~~~~~' );\r
+ gotoxy( 1, 7 );\r
+ textcolor( LightCyan );\r
+ writeln( ' Men£ Principal:' );\r
+ writeln( ' ---- ---------' );\r
+ textcolor( LightGray );\r
+ writeln;\r
+ writeln;\r
+ writeln( ' 1.- Generar Archivo (''DATOS.TXT'').' );\r
+ writeln( ' 2.- Evaluar Algoritmos.' );\r
+ writeln( ' 0.- Salir.' );\r
+ gotoxy( 1, 20 );\r
+ textcolor( White );\r
+ write( ' Ingrese su opci¢n: ' );\r
+ textcolor( Yellow );\r
+ tecla := readkey;\r
+ while ( ( tecla < '1' ) or ( tecla > '2' ) ) and ( tecla <> '0' ) do\r
+ begin\r
+ textcolor( White );\r
+ gotoxy( 1, 20 );\r
+ write( ' Ingrese su opci¢n (1, 2 o 0): ' );\r
+ textcolor( Yellow );\r
+ tecla := readkey;\r
+ end;\r
+ case tecla of\r
+ '1': MenuGenerar( arch );\r
+ '2': MenuEvaluar( datos, arch );\r
+ '0': salir := true;\r
+ end;\r
+ end;\r
+ PantallaSalida;\r
+end.
\ No newline at end of file
--- /dev/null
+program Generador_De_Nombres_Ordenados_Alfabeticamente;\r
+\r
+uses\r
+ CRT;\r
+\r
+const\r
+ MAX_APE = 15;\r
+\r
+type\r
+ APELLIDO = string[MAX_APE];\r
+ DOCUMENTO = 10000000..40000000;\r
+ PERSONA = record\r
+ ap: APELLIDO;\r
+ dni: DOCUMENTO;\r
+ end;\r
+ TABLA = array[1..1000] of PERSONA;\r
+ TIPO_LETRA = ( TL_VOCAL, TL_CONSO );\r
+ TIPO_VOCAL = ( TV_AEIOU, TV_EI );\r
+ INDICADOR = ( I_NADA, I_ESB, I_ESC, I_ESF, I_ESG, I_ESL, I_ESM, I_ESN, I_ESQ, I_ESQU, I_ESR, I_EST );\r
+\r
+(*********************************************************)\r
+\r
+ function GetVocal( tipo: TIPO_VOCAL ): char;\r
+\r
+ var\r
+ valor: integer;\r
+\r
+ begin\r
+ if tipo = TV_AEIOU then valor := random( 16 )\r
+ else valor := random( 6 ) + 5;\r
+ case valor of\r
+ 0..4: GetVocal := 'A';\r
+ 5..7: GetVocal := 'E';\r
+ 8..10: GetVocal := 'I';\r
+ 11..13: GetVocal := 'O';\r
+ 14..15: GetVocal := 'U';\r
+ end;\r
+ end;\r
+\r
+(*********************************************************)\r
+\r
+ procedure GetRNDVocal( var indic: INDICADOR; var proxl: TIPO_LETRA; var vocal: char );\r
+\r
+ var\r
+ valor: integer;\r
+\r
+ begin\r
+ case indic of\r
+ I_ESQ:\r
+ begin\r
+ vocal := 'U';\r
+ indic := I_ESQU;\r
+ proxl := TL_VOCAL;\r
+ end;\r
+ I_ESQU:\r
+ begin\r
+ vocal := GetVocal( TV_EI );\r
+ indic := I_NADA;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ else\r
+ begin\r
+ vocal := GetVocal( TV_AEIOU );\r
+ indic := I_NADA;\r
+ if random( 40 ) = 0 then proxl := TL_VOCAL\r
+ else proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ end;\r
+\r
+(*********************************************************)\r
+\r
+ procedure GetRNDConsonante( var indic: INDICADOR; var proxl: TIPO_LETRA; var conso: char );\r
+\r
+ var\r
+ valor: integer;\r
+\r
+ begin\r
+ proxl := TL_VOCAL;\r
+ indic := I_NADA;\r
+\r
+ case indic of\r
+ I_ESF, I_ESR, I_ESG, I_EST: conso := 'R';\r
+ I_ESB: case random( 2 ) of\r
+ 0: conso := 'R';\r
+ 1: conso := 'L';\r
+ end;\r
+ I_ESC: case random( 4 ) of\r
+ 0: conso := 'C';\r
+ 1: conso := 'H';\r
+ 2: conso := 'R';\r
+ 3: conso := 'L';\r
+ end;\r
+ I_ESL: case random( 6 ) of\r
+ 0: conso := 'T';\r
+ 1..5: conso := 'L';\r
+ end;\r
+ I_ESM: case random( 3 ) of\r
+ 0: conso := 'P';\r
+ 1: conso := 'B';\r
+ 2: conso := 'L';\r
+ end;\r
+ I_ESN: case random( 3 ) of\r
+ 0: conso := 'R';\r
+ 1: conso := 'V';\r
+ 2: conso := 'C';\r
+ end;\r
+ else case random( 55 ) of\r
+ 0..3: begin\r
+ conso := 'B';\r
+ if random( 10 ) = 0 then begin\r
+ indic := I_ESB;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 4..7: begin\r
+ conso := 'C';\r
+ if random( 5 ) = 0 then begin\r
+ indic := I_ESC;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 8..11: conso := 'D';\r
+ 12..14: begin\r
+ conso := 'F';\r
+ if random( 10 ) = 0 then begin\r
+ indic := I_ESF;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 15..17: begin\r
+ conso := 'G';\r
+ if random( 5 ) = 0 then\r
+ begin\r
+ indic := I_ESG;\r
+ if random( 4 ) = 0 then proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 18..19: conso := 'H';\r
+ 20..22: conso := 'J';\r
+ 23..24: conso := 'K';\r
+ 25..27: begin\r
+ conso := 'L';\r
+ if random( 15 ) = 0 then\r
+ begin\r
+ indic := I_ESL;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 28..30: begin\r
+ conso := 'M';\r
+ if random( 5 ) = 0 then\r
+ begin\r
+ indic := I_ESM;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 31..33: begin\r
+ conso := 'N';\r
+ if random( 5 ) = 0 then\r
+ begin\r
+ indic := I_ESN;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 34..36: conso := 'P';\r
+ 37..38: begin\r
+ conso := 'Q';\r
+ indic := I_ESQ;\r
+ end;\r
+ 39..41: begin\r
+ conso := 'R';\r
+ if random( 3 ) = 0 then\r
+ begin\r
+ indic := I_ESR;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 42..44: conso := 'S';\r
+ 45..47: begin\r
+ conso := 'T';\r
+ if random( 10 ) = 0 then\r
+ begin\r
+ indic := I_EST;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 48..50: conso := 'V';\r
+ 51: conso := 'W';\r
+ 52: conso := 'X';\r
+ 53: conso := 'Y';\r
+ 54: conso := 'Z';\r
+ end; { case random( 55 ) of }\r
+\r
+ end; { case indic of }\r
+ end; { procedimiento }\r
+\r
+(*********************************************************)\r
+\r
+ function GetRNDApellido( max, min: integer ): APELLIDO;\r
+\r
+ var\r
+ tam, i: integer;\r
+ aux: char;\r
+ apel: APELLIDO;\r
+ indic: INDICADOR;\r
+ proxl: TIPO_LETRA;\r
+\r
+ begin\r
+ if max > MAX_APE then max := MAX_APE;\r
+ tam := random( max + 1 ) + min;\r
+ indic := I_NADA;\r
+ apel := '';\r
+ if random( 5 ) = 0 then proxl := TL_VOCAL\r
+ else proxl := TL_CONSO;\r
+ for i := 1 to tam do\r
+ begin\r
+ if proxl = TL_CONSO then GetRNDConsonante( indic, proxl, aux )\r
+ else GetRNDVocal( indic, proxl, aux );\r
+ apel := apel + aux;\r
+ end;\r
+ GetRNDApellido := apel;\r
+ end;\r
+\r
+(*********************************************************)\r
+\r
+ function GetRNDLetra( min, max: char ): char;\r
+\r
+ begin\r
+ GetRNDLetra := chr( random( ord( max ) - ord( min ) + 1 ) + ord( min ) );\r
+ end;\r
+\r
+\r
+(*********************************************************)\r
+ procedure GetInvOrdApellidos( var ar: text; cant: integer );\r
+\r
+ var\r
+ mil: boolean;\r
+ letra, letra1: char;\r
+ i, j, veces: integer;\r
+ dni: DOCUMENTO;\r
+ ap, ape, apel: APELLIDO;\r
+\r
+ begin\r
+ mil := false;\r
+ if cant = 1000 then mil := true;\r
+ dni := 34000000 + (random( 15000 ) * 100);\r
+ ap := '';\r
+ ape := '';\r
+ apel := '';\r
+ for letra := 'Z' downto 'A' do\r
+ begin\r
+ ap := letra;\r
+ for letra1 := 'Z' downto 'A' do\r
+ begin\r
+ if mil then\r
+ case letra of\r
+ 'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T':\r
+ case letra1 of\r
+ 'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T', 'Z': veces := 2;\r
+ else veces := 1;\r
+ end;\r
+ else case letra1 of\r
+ 'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T': veces := 2;\r
+ else veces := 1;\r
+ end;\r
+ end\r
+ else\r
+ case letra of\r
+ 'A', 'B', 'C', 'D', 'E', 'F', 'I', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T', 'V':\r
+ case letra1 of\r
+ 'D', 'F', 'G', 'H', 'I', 'J', 'K', 'U', 'V': veces := 2;\r
+ else veces := 1;\r
+ end;\r
+ else case letra1 of\r
+ 'D', 'F', 'G', 'H', 'I', 'J', 'K', 'U': veces := 2;\r
+ else veces := 1;\r
+ end;\r
+ end;\r
+ ape := ap + letra1;\r
+ for j := 1 to veces do\r
+ begin\r
+ if j <> 1 then apel := ape + GetRNDLetra( 'A', 'M' ) + GetRNDApellido( 6, 1 )\r
+ else apel := ape + GetRNDLetra( 'N', 'Z' ) + GetRNDApellido( 6, 1 );\r
+ dni := dni - random( 50000 ) - 1;\r
+ writeln( ar, apel );\r
+ writeln( ar, dni );\r
+ writeln( ar );\r
+ apel := '';\r
+ end;\r
+\r
+ ape := '';\r
+\r
+ end; { for letra1 := 'A' to 'Z' do }\r
+\r
+ ap := '';\r
+\r
+ end; { for letra := 'A' to 'Z' do }\r
+\r
+ end; { procedure }\r
+\r
+(*********************************************************)\r
+\r
+var\r
+ datos: TABLA;\r
+ arch: text;\r
+ dni: DOCUMENTO;\r
+ i, n: integer;\r
+\r
+begin\r
+ randomize;\r
+\r
+ n := 1000;\r
+ assign( arch, 'DATOS.TXT' );\r
+ rewrite( arch );\r
+ readln( n );\r
+ GetInvOrdApellidos( arch, n );\r
+ close( arch );\r
+end.
\ No newline at end of file
--- /dev/null
+program Generador_De_Nombres_Ordenados_Alfabeticamente;\r
+\r
+uses\r
+ CRT;\r
+\r
+const\r
+ MAX_APE = 15;\r
+\r
+type\r
+ APELLIDO = string[MAX_APE];\r
+ DOCUMENTO = 10000000..40000000;\r
+ PERSONA = record\r
+ ap: APELLIDO;\r
+ dni: DOCUMENTO;\r
+ end;\r
+ TABLA = array[1..1000] of PERSONA;\r
+ TIPO_LETRA = ( TL_VOCAL, TL_CONSO );\r
+ TIPO_VOCAL = ( TV_AEIOU, TV_EI );\r
+ INDICADOR = ( I_NADA, I_ESB, I_ESC, I_ESF, I_ESG, I_ESL, I_ESM, I_ESN, I_ESQ, I_ESQU, I_ESR, I_EST );\r
+\r
+(*********************************************************)\r
+\r
+ function GetVocal( tipo: TIPO_VOCAL ): char;\r
+\r
+ var\r
+ valor: integer;\r
+\r
+ begin\r
+ if tipo = TV_AEIOU then valor := random( 16 )\r
+ else valor := random( 6 ) + 5;\r
+ case valor of\r
+ 0..4: GetVocal := 'A';\r
+ 5..7: GetVocal := 'E';\r
+ 8..10: GetVocal := 'I';\r
+ 11..13: GetVocal := 'O';\r
+ 14..15: GetVocal := 'U';\r
+ end;\r
+ end;\r
+\r
+(*********************************************************)\r
+\r
+ procedure GetRNDVocal( var indic: INDICADOR; var proxl: TIPO_LETRA; var vocal: char );\r
+\r
+ var\r
+ valor: integer;\r
+\r
+ begin\r
+ case indic of\r
+ I_ESQ:\r
+ begin\r
+ vocal := 'U';\r
+ indic := I_ESQU;\r
+ proxl := TL_VOCAL;\r
+ end;\r
+ I_ESQU:\r
+ begin\r
+ vocal := GetVocal( TV_EI );\r
+ indic := I_NADA;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ else\r
+ begin\r
+ vocal := GetVocal( TV_AEIOU );\r
+ indic := I_NADA;\r
+ if random( 40 ) = 0 then proxl := TL_VOCAL\r
+ else proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ end;\r
+\r
+(*********************************************************)\r
+\r
+ procedure GetRNDConsonante( var indic: INDICADOR; var proxl: TIPO_LETRA; var conso: char );\r
+\r
+ var\r
+ valor: integer;\r
+\r
+ begin\r
+ proxl := TL_VOCAL;\r
+ indic := I_NADA;\r
+\r
+ case indic of\r
+ I_ESF, I_ESR, I_ESG, I_EST: conso := 'R';\r
+ I_ESB: case random( 2 ) of\r
+ 0: conso := 'R';\r
+ 1: conso := 'L';\r
+ end;\r
+ I_ESC: case random( 4 ) of\r
+ 0: conso := 'C';\r
+ 1: conso := 'H';\r
+ 2: conso := 'R';\r
+ 3: conso := 'L';\r
+ end;\r
+ I_ESL: case random( 6 ) of\r
+ 0: conso := 'T';\r
+ 1..5: conso := 'L';\r
+ end;\r
+ I_ESM: case random( 3 ) of\r
+ 0: conso := 'P';\r
+ 1: conso := 'B';\r
+ 2: conso := 'L';\r
+ end;\r
+ I_ESN: case random( 3 ) of\r
+ 0: conso := 'R';\r
+ 1: conso := 'V';\r
+ 2: conso := 'C';\r
+ end;\r
+ else case random( 55 ) of\r
+ 0..3: begin\r
+ conso := 'B';\r
+ if random( 10 ) = 0 then begin\r
+ indic := I_ESB;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 4..7: begin\r
+ conso := 'C';\r
+ if random( 5 ) = 0 then begin\r
+ indic := I_ESC;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 8..11: conso := 'D';\r
+ 12..14: begin\r
+ conso := 'F';\r
+ if random( 10 ) = 0 then begin\r
+ indic := I_ESF;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 15..17: begin\r
+ conso := 'G';\r
+ if random( 5 ) = 0 then\r
+ begin\r
+ indic := I_ESG;\r
+ if random( 4 ) = 0 then proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 18..19: conso := 'H';\r
+ 20..22: conso := 'J';\r
+ 23..24: conso := 'K';\r
+ 25..27: begin\r
+ conso := 'L';\r
+ if random( 15 ) = 0 then\r
+ begin\r
+ indic := I_ESL;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 28..30: begin\r
+ conso := 'M';\r
+ if random( 5 ) = 0 then\r
+ begin\r
+ indic := I_ESM;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 31..33: begin\r
+ conso := 'N';\r
+ if random( 5 ) = 0 then\r
+ begin\r
+ indic := I_ESN;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 34..36: conso := 'P';\r
+ 37..38: begin\r
+ conso := 'Q';\r
+ indic := I_ESQ;\r
+ end;\r
+ 39..41: begin\r
+ conso := 'R';\r
+ if random( 3 ) = 0 then\r
+ begin\r
+ indic := I_ESR;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 42..44: conso := 'S';\r
+ 45..47: begin\r
+ conso := 'T';\r
+ if random( 10 ) = 0 then\r
+ begin\r
+ indic := I_EST;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 48..50: conso := 'V';\r
+ 51: conso := 'W';\r
+ 52: conso := 'X';\r
+ 53: conso := 'Y';\r
+ 54: conso := 'Z';\r
+ end; { case random( 55 ) of }\r
+\r
+ end; { case indic of }\r
+ end; { procedimiento }\r
+\r
+(*********************************************************)\r
+\r
+ function GetRNDApellido( max, min: integer ): APELLIDO;\r
+\r
+ var\r
+ tam, i: integer;\r
+ aux: char;\r
+ apel: APELLIDO;\r
+ indic: INDICADOR;\r
+ proxl: TIPO_LETRA;\r
+\r
+ begin\r
+ if max > MAX_APE then max := MAX_APE;\r
+ tam := random( max + 1 ) + min;\r
+ indic := I_NADA;\r
+ apel := '';\r
+ if random( 5 ) = 0 then proxl := TL_VOCAL\r
+ else proxl := TL_CONSO;\r
+ for i := 1 to tam do\r
+ begin\r
+ if proxl = TL_CONSO then GetRNDConsonante( indic, proxl, aux )\r
+ else GetRNDVocal( indic, proxl, aux );\r
+ apel := apel + aux;\r
+ end;\r
+ GetRNDApellido := apel;\r
+ end;\r
+\r
+(*********************************************************)\r
+\r
+ function GetRNDLetra( min, max: char ): char;\r
+\r
+ begin\r
+ GetRNDLetra := chr( random( ord( max ) - ord( min ) + 1 ) + ord( min ) );\r
+ end;\r
+\r
+\r
+(*********************************************************)\r
+ procedure GetOrdApellidos( var ar: text; cant: integer );\r
+\r
+ var\r
+ mil: boolean;\r
+ letra, letra1: char;\r
+ i, j, veces: integer;\r
+ dni: DOCUMENTO;\r
+ ap, ape, apel: APELLIDO;\r
+\r
+ begin\r
+ mil := false;\r
+ if cant = 1000 then mil := true;\r
+ dni := 10000000 + (random( 15000 ) * 100);\r
+ ap := '';\r
+ ape := '';\r
+ apel := '';\r
+ for letra := 'A' to 'Z' do\r
+ begin\r
+ ap := letra;\r
+ for letra1 := 'A' to 'Z' do\r
+ begin\r
+ {\r
+ writeln( ar, 'ciclo for letra1 := ''A'' to ''Z'' do. letra1: ', letra1 );\r
+ }\r
+ if mil then\r
+ case letra of\r
+ 'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T':\r
+ case letra1 of\r
+ 'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T', 'Z': veces := 2;\r
+ else veces := 1;\r
+ end;\r
+ else case letra1 of\r
+ 'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T': veces := 2;\r
+ else veces := 1;\r
+ end;\r
+ end\r
+ else\r
+ case letra of\r
+ 'A', 'B', 'C', 'D', 'E', 'F', 'I', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T', 'V':\r
+ case letra1 of\r
+ 'D', 'F', 'G', 'H', 'I', 'J', 'K', 'U', 'V': veces := 2;\r
+ else veces := 1;\r
+ end;\r
+ else case letra1 of\r
+ 'D', 'F', 'G', 'H', 'I', 'J', 'K', 'U': veces := 2;\r
+ else veces := 1;\r
+ end;\r
+ end;\r
+ ape := ap + letra1;\r
+ for j := 1 to veces do\r
+ begin\r
+ if j = 1 then apel := ape + GetRNDLetra( 'A', 'M' ) + GetRNDApellido( 6, 1 )\r
+ else apel := ape + GetRNDLetra( 'N', 'Z' ) + GetRNDApellido( 6, 1 );\r
+ dni := dni + random( 50000 ) + 1;\r
+ writeln( ar, apel );\r
+ writeln( ar, dni );\r
+ writeln( ar );\r
+ apel := '';\r
+\r
+ {writeln( ar, 'apel := NADA' );}\r
+ {delay( 500 );}\r
+ end;\r
+ ape := '';\r
+\r
+ {writeln( ar, 'ape := NADA' );}\r
+ {delay( 500 );}\r
+\r
+ end; { for letra1 := 'A' to 'Z' do }\r
+\r
+ {writeln( ar, 'En AP: ', ap );}\r
+\r
+ ap := '';\r
+\r
+ {writeln( ar, 'ap := NADA' );}\r
+ {delay( 500 );}\r
+\r
+ end; { for letra := 'A' to 'Z' do }\r
+\r
+ end; { procedure }\r
+\r
+(*********************************************************)\r
+\r
+var\r
+ datos: TABLA;\r
+ arch: text;\r
+ dni: DOCUMENTO;\r
+ i, n: integer;\r
+\r
+begin\r
+ randomize;\r
+\r
+ n := 1000;\r
+ assign( arch, 'DATOS.TXT' );\r
+ rewrite( arch );\r
+ readln( n );\r
+ GetOrdApellidos( arch, n );\r
+ close( arch );\r
+end.
\ No newline at end of file
--- /dev/null
+program RNDNames;\r
+\r
+const\r
+ MAX_APE = 15;\r
+\r
+type\r
+ APELLIDO = string[MAX_APE];\r
+ DOCUMENTO = 10000000..40000000;\r
+ PERSONA = record\r
+ ap: APELLIDO;\r
+ dni: DOCUMENTO;\r
+ end;\r
+ TABLA = array[1..1000] of PERSONA;\r
+ TIPO_LETRA = ( TL_VOCAL, TL_CONSO );\r
+ TIPO_VOCAL = ( TV_AEIOU, TV_EI );\r
+ INDICADOR = ( I_NADA, I_ESB, I_ESC, I_ESF, I_ESG, I_ESL, I_ESM, I_ESN, I_ESQ, I_ESQU, I_ESR, I_EST );\r
+\r
+(*********************************************************)\r
+\r
+ function GetVocal( tipo: TIPO_VOCAL ): char;\r
+\r
+ var\r
+ valor: integer;\r
+\r
+ begin\r
+ if tipo = TV_AEIOU then valor := random( 16 )\r
+ else valor := random( 6 ) + 5;\r
+ case valor of\r
+ 0..4: GetVocal := 'A';\r
+ 5..7: GetVocal := 'E';\r
+ 8..10: GetVocal := 'I';\r
+ 11..13: GetVocal := 'O';\r
+ 14..15: GetVocal := 'U';\r
+ end;\r
+ end;\r
+\r
+(*********************************************************)\r
+\r
+ procedure GetRNDVocal( var indic: INDICADOR; var proxl: TIPO_LETRA; var vocal: char );\r
+\r
+ var\r
+ valor: integer;\r
+\r
+ begin\r
+ case indic of\r
+ I_ESQ:\r
+ begin\r
+ vocal := 'U';\r
+ indic := I_ESQU;\r
+ proxl := TL_VOCAL;\r
+ end;\r
+ I_ESQU:\r
+ begin\r
+ vocal := GetVocal( TV_EI );\r
+ indic := I_NADA;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ else\r
+ begin\r
+ vocal := GetVocal( TV_AEIOU );\r
+ indic := I_NADA;\r
+ if random( 40 ) = 0 then proxl := TL_VOCAL\r
+ else proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ end;\r
+\r
+(*********************************************************)\r
+\r
+ procedure GetRNDConsonante( var indic: INDICADOR; var proxl: TIPO_LETRA; var conso: char );\r
+\r
+ var\r
+ valor: integer;\r
+\r
+ begin\r
+ proxl := TL_VOCAL;\r
+ indic := I_NADA;\r
+\r
+ case indic of\r
+ I_ESF, I_ESR, I_ESG, I_EST: conso := 'R';\r
+ I_ESB: case random( 2 ) of\r
+ 0: conso := 'R';\r
+ 1: conso := 'L';\r
+ end;\r
+ I_ESC: case random( 4 ) of\r
+ 0: conso := 'C';\r
+ 1: conso := 'H';\r
+ 2: conso := 'R';\r
+ 3: conso := 'L';\r
+ end;\r
+ I_ESL: case random( 6 ) of\r
+ 0: conso := 'T';\r
+ 1..5: conso := 'L';\r
+ end;\r
+ I_ESM: case random( 3 ) of\r
+ 0: conso := 'P';\r
+ 1: conso := 'B';\r
+ 2: conso := 'L';\r
+ end;\r
+ I_ESN: case random( 3 ) of\r
+ 0: conso := 'R';\r
+ 1: conso := 'V';\r
+ 2: conso := 'C';\r
+ end;\r
+ else case random( 55 ) of\r
+ 0..3: begin\r
+ conso := 'B';\r
+ if random( 10 ) = 0 then begin\r
+ indic := I_ESB;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 4..7: begin\r
+ conso := 'C';\r
+ if random( 5 ) = 0 then begin\r
+ indic := I_ESC;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 8..11: conso := 'D';\r
+ 12..14: begin\r
+ conso := 'F';\r
+ if random( 10 ) = 0 then begin\r
+ indic := I_ESF;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 15..17: begin\r
+ conso := 'G';\r
+ if random( 5 ) = 0 then\r
+ begin\r
+ indic := I_ESG;\r
+ if random( 4 ) = 0 then proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 18..19: conso := 'H';\r
+ 20..22: conso := 'J';\r
+ 23..24: conso := 'K';\r
+ 25..27: begin\r
+ conso := 'L';\r
+ if random( 15 ) = 0 then\r
+ begin\r
+ indic := I_ESL;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 28..30: begin\r
+ conso := 'M';\r
+ if random( 5 ) = 0 then\r
+ begin\r
+ indic := I_ESM;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 31..33: begin\r
+ conso := 'N';\r
+ if random( 5 ) = 0 then\r
+ begin\r
+ indic := I_ESN;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 34..36: conso := 'P';\r
+ 37..38: begin\r
+ conso := 'Q';\r
+ indic := I_ESQ;\r
+ end;\r
+ 39..41: begin\r
+ conso := 'R';\r
+ if random( 3 ) = 0 then\r
+ begin\r
+ indic := I_ESR;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 42..44: conso := 'S';\r
+ 45..47: begin\r
+ conso := 'T';\r
+ if random( 10 ) = 0 then\r
+ begin\r
+ indic := I_EST;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 48..50: conso := 'V';\r
+ 51: conso := 'W';\r
+ 52: conso := 'X';\r
+ 53: conso := 'Y';\r
+ 54: conso := 'Z';\r
+ end; { case random( 55 ) of }\r
+\r
+ end; { case indic of }\r
+ end; { procedimiento }\r
+\r
+(*********************************************************)\r
+\r
+ function GetRNDApellido( max, min: integer ): APELLIDO;\r
+\r
+ var\r
+ tam, i: integer;\r
+ aux: char;\r
+ apel: APELLIDO;\r
+ indic: INDICADOR;\r
+ proxl: TIPO_LETRA;\r
+\r
+ begin\r
+ if max > MAX_APE then max := MAX_APE;\r
+ tam := random( max + 1 ) + min;\r
+ indic := I_NADA;\r
+ apel := '';\r
+ if random( 5 ) = 0 then proxl := TL_VOCAL\r
+ else proxl := TL_CONSO;\r
+ for i := 1 to tam do\r
+ begin\r
+ if proxl = TL_CONSO then GetRNDConsonante( indic, proxl, aux )\r
+ else GetRNDVocal( indic, proxl, aux );\r
+ apel := apel + aux;\r
+ end;\r
+ GetRNDApellido := apel;\r
+ end;\r
+\r
+var\r
+ n, i: integer;\r
+ arch: text;\r
+ ap: APELLIDO;\r
+ dni: DOCUMENTO;\r
+\r
+begin\r
+ randomize;\r
+ n := 1000;\r
+ assign( arch, 'DATOS.TXT' );\r
+ rewrite( arch );\r
+ dni := 10000000 + (random( 15000 ) * 100);\r
+\r
+ for i := 1 to n do\r
+ begin\r
+ ap := GetRNDApellido( 7, 4 );\r
+ dni := dni + random( 50000 ) + 1;\r
+ writeln( arch, ap );\r
+ writeln( arch, dni );\r
+ writeln( arch );\r
+ end;\r
+ close( arch );\r
+end.\r
--- /dev/null
+{ Updated SORTING.SWG on May 26, 1995 }\r
+\r
+{\r
+>I've been programming for a couple years now, but there are certain things\r
+>that you seldom just figure out on your own. One of them is the multitude\r
+>of standard sorting techniques. I did learn these, however, in a class I\r
+>took last year in Turbo Pascal. Let's see, Bubble Sort, Selection Sort,\r
+>Quick Sort.. I think that's what they were called. Anyway, if anyone\r
+>has the time and desire I'd appreciate a quick run-down of each and if\r
+>possible some source for using them on a linked list. I remember most of\r
+>the code to do them on arrays, but I forget which are the most efficient\r
+>for each type of data.\r
+\r
+Here is a program that I was given to demonstrate 8 different types of sorts.\r
+I don't claim to know how they work, but it does shed some light on what the\r
+best type probably is. BTW, it can be modified to allow for a random number\r
+of sort elements (up to maxint div 10 I believe).\r
+\r
+ ALLSORT.PAS: Demonstration of various sorting methods.\r
+ Released to the public domain by Wayel A. Al-Wohaibi.\r
+\r
+ ALLSORT.PAS was written in Turbo Pascal 3.0 (but compatible with\r
+ TP6.0) while taking a pascal course in 1988. It is provided as is,\r
+ to demonstrate how sorting algorithms work. Sorry, no documentation\r
+ (didn't imagine it would be worth releasing) but bugs are included\r
+ too!\r
+\r
+ ALLSORT simply shows you how elements are rearranged in each\r
+ iteration of each of the eight popular sorting methods.\r
+}\r
+\r
+program SORTINGMETHODS;\r
+uses\r
+ Crt;\r
+\r
+const\r
+ N = 14; (* NO. OF DATA TO BE SORTED *)\r
+ Digits = 3; (* DIGITAL SIZE OF THE DATA *)\r
+ Range = 1000; (* RANGE FOR THE RANDOM GENERATOR *)\r
+\r
+type\r
+ ArrayType = array[1..N] of integer;\r
+ TwoDimension = array[0..9, 1..N] of integer; (* FOR RADIX SORT ONLY *)\r
+\r
+var\r
+ Data : ArrayType;\r
+ D : integer;\r
+\r
+ (*--------------------------------------------------------------------*)\r
+\r
+ procedure GetSortMethod;\r
+ begin\r
+ clrscr;\r
+ writeln;\r
+ writeln(' CHOOSE: ');\r
+ writeln(' ');\r
+ writeln(' 1 FOR SELECT SORT ');\r
+ writeln(' 2 FOR INSERT SORT ');\r
+ writeln(' 3 FOR BUBBLE SORT ');\r
+ writeln(' 4 FOR SHAKE SORT ');\r
+ writeln(' 5 FOR HEAP SORT ');\r
+ writeln(' 6 FOR QUICK SORT ');\r
+ writeln(' 7 FOR SHELL SORT ');\r
+ writeln(' 8 FOR RADIX SORT ');\r
+ writeln(' 9 TO EXIT ALLSORT ');\r
+ writeln(' ');\r
+ writeln;\r
+ readln(D)\r
+ end;\r
+\r
+ procedure LoadList;\r
+ var\r
+ I : integer;\r
+ begin\r
+ for I := 1 to N do\r
+ Data[I] := random(Range)\r
+ end;\r
+\r
+ procedure ShowInput;\r
+ var\r
+ I : integer;\r
+ begin\r
+ clrscr;\r
+ write('INPUT :');\r
+ for I := 1 to N do\r
+ write(Data[I]:5);\r
+ writeln\r
+ end;\r
+\r
+ procedure ShowOutput;\r
+ var\r
+ I : integer;\r
+ begin\r
+ write('OUTPUT:');\r
+ for I := 1 to N do\r
+ write(Data[I]:5)\r
+ end;\r
+\r
+ procedure Swap(var X, Y : integer);\r
+ var\r
+ Temp : integer;\r
+ begin\r
+ Temp := X;\r
+ X := Y;\r
+ Y := Temp\r
+ end;\r
+\r
+ (*-------------------------- R A D I X S O R T ---------------------*)\r
+\r
+ function Hash(Number, H : integer) : integer;\r
+ begin\r
+ case H of\r
+ 3 : Hash := Number mod 10;\r
+ 2 : Hash := (Number mod 100) div 10;\r
+ 1 : Hash := Number div 100\r
+ end\r
+ end;\r
+\r
+ procedure CleanArray(var TwoD : TwoDimension);\r
+ var\r
+ I, J : integer;\r
+ begin\r
+ for I := 0 to 9 do\r
+ for J := 1 to N do\r
+ TwoD[I, J] := 0\r
+ end;\r
+\r
+ procedure PlaceIt(var X : TwoDimension; Number, I : integer);\r
+ var\r
+ J : integer;\r
+ Empty : boolean;\r
+ begin\r
+ J := 1;\r
+ Empty := false;\r
+ repeat\r
+ if (X[I, J] > 0) then\r
+ J := J + 1\r
+ else\r
+ Empty := true;\r
+ until (Empty) or (J = N);\r
+ X[I, J] := Number\r
+ end;\r
+\r
+ procedure UnLoadIt(X : TwoDimension; var Passed : ArrayType);\r
+ var\r
+ I,\r
+ J,\r
+ K : integer;\r
+ begin\r
+ K := 1;\r
+ for I := 0 to 9 do\r
+ for J := 1 to N do\r
+ begin\r
+ if (X[I, J] > 0) then\r
+ begin\r
+ Passed[K] := X[I, J];\r
+ K := K + 1\r
+ end\r
+ end\r
+ end;\r
+\r
+ procedure RadixSort(var Pass : ArrayType; N : integer);\r
+ var\r
+ Temp : TwoDimension;\r
+ Element,\r
+ Key,\r
+ Digit,\r
+ I : integer;\r
+ begin\r
+ for Digit := Digits downto 1 do\r
+ begin\r
+ CleanArray(Temp);\r
+ for I := 1 to N do\r
+ begin\r
+ Element := Pass[I];\r
+ Key := Hash(Element, Digit);\r
+ PlaceIt(Temp, Element, Key)\r
+ end;\r
+ UnLoadIt(Temp, Pass);\r
+ ShowOutput;\r
+ readln\r
+ end\r
+ end;\r
+\r
+ (*-------------------------- H E A P S O R T -----------------------*)\r
+\r
+ procedure ReHeapDown(var HEAPData : ArrayType; Root, Bottom : integer);\r
+ var\r
+ HeapOk : boolean;\r
+ MaxChild : integer;\r
+ begin\r
+ HeapOk := false;\r
+ while (Root * 2 <= Bottom)\r
+ and not HeapOk do\r
+ begin\r
+ if (Root * 2 = Bottom) then\r
+ MaxChild := Root * 2\r
+ else\r
+ if (HEAPData[Root * 2] > HEAPData[Root * 2 + 1]) then\r
+ MaxChild := Root * 2\r
+ else\r
+ MaxChild := Root * 2 + 1;\r
+ if (HEAPData[Root] < HEAPData[MaxChild]) then\r
+ begin\r
+ Swap(HEAPData[Root], HEAPData[MaxChild]);\r
+ Root := MaxChild\r
+ end\r
+ else\r
+ HeapOk := true\r
+ end\r
+ end;\r
+\r
+ procedure HeapSort(var Data : ArrayType; NUMElementS : integer);\r
+ var\r
+ NodeIndex : integer;\r
+ begin\r
+ for NodeIndex := (NUMElementS div 2) downto 1 do\r
+ ReHeapDown(Data, NodeIndex, NUMElementS);\r
+ for NodeIndex := NUMElementS downto 2 do\r
+ begin\r
+ Swap(Data[1], Data[NodeIndex]);\r
+ ReHeapDown(Data, 1, NodeIndex - 1);\r
+ ShowOutput;\r
+ readln;\r
+ end\r
+ end;\r
+\r
+ (*-------------------------- I N S E R T S O R T -------------------*)\r
+\r
+ procedure StrInsert(var X : ArrayType; N : integer);\r
+ var\r
+ J,\r
+ K,\r
+ Y : integer;\r
+ Found : boolean;\r
+ begin\r
+ for J := 2 to N do\r
+ begin\r
+ Y := X[J];\r
+ K := J - 1;\r
+ Found := false;\r
+ while (K >= 1)\r
+ and (not Found) do\r
+ if (Y < X[K]) then\r
+ begin\r
+ X[K + 1] := X[K];\r
+ K := K - 1\r
+ end\r
+ else\r
+ Found := true;\r
+ X[K + 1] := Y;\r
+ ShowOutput;\r
+ readln\r
+ end\r
+ end;\r
+\r
+ (*-------------------------- S H E L L S O R T ---------------------*)\r
+\r
+ procedure ShellSort(var A : ArrayType; N : integer);\r
+ var\r
+ Done : boolean;\r
+ Jump,\r
+ I,\r
+ J : integer;\r
+ begin\r
+ Jump := N;\r
+ while (Jump > 1) do\r
+ begin\r
+ Jump := Jump div 2;\r
+ repeat\r
+ Done := true;\r
+ for J := 1 to (N - Jump) do\r
+ begin\r
+ I := J + Jump;\r
+ if (A[J] > A[I]) then\r
+ begin\r
+ Swap(A[J], A[I]);\r
+ Done := false\r
+ end;\r
+ end;\r
+ until Done;\r
+ ShowOutput;\r
+ readln\r
+ end\r
+ end;\r
+\r
+ (*-------------------------- B U B B L E S O R T -------------------*)\r
+\r
+ procedure BubbleSort(var X : ArrayType; N : integer);\r
+ var\r
+ I,\r
+ J : integer;\r
+ begin\r
+ for I := 2 to N do\r
+ begin\r
+ for J := N downto I do\r
+ if (X[J] < X[J - 1]) then\r
+ Swap(X[J - 1], X[J]);\r
+ ShowOutput;\r
+ readln\r
+ end\r
+ end;\r
+\r
+ (*-------------------------- S H A K E S O R T ---------------------*)\r
+\r
+ procedure ShakeSort(var X : ArrayType; N : integer);\r
+ var\r
+ L,\r
+ R,\r
+ K,\r
+ J : integer;\r
+ begin\r
+ L := 2;\r
+ R := N;\r
+ K := N;\r
+ repeat\r
+ for J := R downto L do\r
+ if (X[J] < X[J - 1]) then\r
+ begin\r
+ Swap(X[J], X[J - 1]);\r
+ K := J\r
+ end;\r
+ L := K + 1;\r
+ for J := L to R do\r
+ if (X[J] < X[J - 1]) then\r
+ begin\r
+ Swap(X[J], X[J - 1]);\r
+ K := J\r
+ end;\r
+ R := K - 1;\r
+ ShowOutput;\r
+ readln;\r
+ until L >= R\r
+ end;\r
+\r
+ (*-------------------------- Q W I C K S O R T ---------------------*)\r
+\r
+ procedure Partition(var A : ArrayType; First, Last : integer);\r
+ var\r
+ Right,\r
+ Left : integer;\r
+ V : integer;\r
+ begin\r
+ V := A[(First + Last) div 2];\r
+ Right := First;\r
+ Left := Last;\r
+ repeat\r
+ while (A[Right] < V) do\r
+ Right := Right + 1;\r
+ while (A[Left] > V) do\r
+ Left := Left - 1;\r
+ if (Right <= Left) then\r
+ begin\r
+ Swap(A[Right], A[Left]);\r
+ Right := Right + 1;\r
+ Left := Left - 1\r
+ end;\r
+ until Right > Left;\r
+ ShowOutput;\r
+ readln;\r
+ if (First < Left) then\r
+ Partition(A, First, Left);\r
+ if (Right < Last) then\r
+ Partition(A, Right, Last)\r
+ end;\r
+\r
+ procedure QuickSort(var List : ArrayType; N : integer);\r
+ var\r
+ First,\r
+ Last : integer;\r
+ begin\r
+ First := 1;\r
+ Last := N;\r
+ if (First < Last) then\r
+ Partition(List, First, Last)\r
+ end;\r
+\r
+ (*-------------------------- S E L E C T S O R T -------------------*)\r
+\r
+ procedure StrSelectSort(var X : ArrayType; N : integer);\r
+ var\r
+ I,\r
+ J,\r
+ K,\r
+ Y : integer;\r
+ begin\r
+ for I := 1 to N - 1 do\r
+ begin\r
+ K := I;\r
+ Y := X[I];\r
+ for J := (I + 1) to N do\r
+ if (X[J] < Y) then\r
+ begin\r
+ K := J;\r
+ Y := X[J]\r
+ end;\r
+ X[K] := X[J];\r
+ X[I] := Y;\r
+ ShowOutput;\r
+ readln\r
+ end\r
+ end;\r
+\r
+ (*--------------------------------------------------------------------*)\r
+\r
+ procedure Sort;\r
+ begin\r
+ case D of\r
+ 1 : StrSelectSort(Data, N);\r
+ 2 : StrInsert(Data, N);\r
+ 3 : BubbleSort(Data, N);\r
+ 4 : ShakeSort(Data, N);\r
+ 5 : HeapSort(Data, N);\r
+ 6 : QuickSort(Data, N);\r
+ 7 : ShellSort(Data, N);\r
+ 8 : RadixSort(Data, N);\r
+ else\r
+ writeln('BAD INPUT')\r
+ end\r
+ end;\r
+\r
+ (*-------------------------------------------------------------------*)\r
+\r
+BEGIN\r
+ GetSortMethod;\r
+ while (D <> 9) do\r
+ begin\r
+ LoadList;\r
+ ShowInput;\r
+ Sort;\r
+ writeln('PRESS ENTER TO RETURN');\r
+ readln;\r
+ GetSortMethod\r
+ end\r
+END.
\ No newline at end of file
--- /dev/null
+program RNDNames;\r
+\r
+const\r
+ MAX_APE = 15;\r
+\r
+type\r
+ APELLIDO = string[MAX_APE];\r
+ DOCUMENTO = 10000000..40000000;\r
+ PERSONA = record\r
+ ap: APELLIDO;\r
+ dni: DOCUMENTO;\r
+ end;\r
+ TABLA = array[1..1000] of PERSONA;\r
+ TIPO_LETRA = ( TL_VOCAL, TL_CONSO );\r
+ TIPO_VOCAL = ( TV_AEIOU, TV_EI );\r
+ INDICADOR = ( I_NADA, I_ESB, I_ESC, I_ESF, I_ESG, I_ESL, I_ESM, I_ESN, I_ESQ, I_ESQU, I_ESR, I_EST );\r
+\r
+(*********************************************************)\r
+\r
+ function GetVocal( tipo: TIPO_VOCAL ): char;\r
+\r
+ var\r
+ valor: integer;\r
+\r
+ begin\r
+ if tipo = TV_AEIOU then valor := random( 16 )\r
+ else valor := random( 6 ) + 5;\r
+ case valor of\r
+ 0..4: GetVocal := 'A';\r
+ 5..7: GetVocal := 'E';\r
+ 8..10: GetVocal := 'I';\r
+ 11..13: GetVocal := 'O';\r
+ 14..15: GetVocal := 'U';\r
+ end;\r
+ end;\r
+\r
+(*********************************************************)\r
+\r
+ procedure GetRNDVocal( var indic: INDICADOR; var proxl: TIPO_LETRA; var vocal: char );\r
+\r
+ var\r
+ valor: integer;\r
+\r
+ begin\r
+ case indic of\r
+ I_ESQ:\r
+ begin\r
+ vocal := 'U';\r
+ indic := I_ESQU;\r
+ proxl := TL_VOCAL;\r
+ end;\r
+ I_ESQU:\r
+ begin\r
+ vocal := GetVocal( TV_EI );\r
+ indic := I_NADA;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ else\r
+ begin\r
+ vocal := GetVocal( TV_AEIOU );\r
+ indic := I_NADA;\r
+ if random( 40 ) = 0 then proxl := TL_VOCAL\r
+ else proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ end;\r
+\r
+(*********************************************************)\r
+\r
+ procedure GetRNDConsonante( var indic: INDICADOR; var proxl: TIPO_LETRA; var conso: char );\r
+\r
+ var\r
+ valor: integer;\r
+\r
+ begin\r
+ proxl := TL_VOCAL;\r
+ indic := I_NADA;\r
+\r
+ case indic of\r
+ I_ESF, I_ESR, I_ESG, I_EST: conso := 'R';\r
+ I_ESB: case random( 2 ) of\r
+ 0: conso := 'R';\r
+ 1: conso := 'L';\r
+ end;\r
+ I_ESC: case random( 4 ) of\r
+ 0: conso := 'C';\r
+ 1: conso := 'H';\r
+ 2: conso := 'R';\r
+ 3: conso := 'L';\r
+ end;\r
+ I_ESL: case random( 6 ) of\r
+ 0: conso := 'T';\r
+ 1..5: conso := 'L';\r
+ end;\r
+ I_ESM: case random( 3 ) of\r
+ 0: conso := 'P';\r
+ 1: conso := 'B';\r
+ 2: conso := 'L';\r
+ end;\r
+ I_ESN: case random( 3 ) of\r
+ 0: conso := 'R';\r
+ 1: conso := 'V';\r
+ 2: conso := 'C';\r
+ end;\r
+ else case random( 55 ) of\r
+ 0..3: begin\r
+ conso := 'B';\r
+ if random( 10 ) = 0 then begin\r
+ indic := I_ESB;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 4..7: begin\r
+ conso := 'C';\r
+ if random( 5 ) = 0 then begin\r
+ indic := I_ESC;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 8..11: conso := 'D';\r
+ 12..14: begin\r
+ conso := 'F';\r
+ if random( 10 ) = 0 then begin\r
+ indic := I_ESF;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 15..17: begin\r
+ conso := 'G';\r
+ if random( 5 ) = 0 then\r
+ begin\r
+ indic := I_ESG;\r
+ if random( 4 ) = 0 then proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 18..19: conso := 'H';\r
+ 20..22: conso := 'J';\r
+ 23..24: conso := 'K';\r
+ 25..27: begin\r
+ conso := 'L';\r
+ if random( 15 ) = 0 then\r
+ begin\r
+ indic := I_ESL;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 28..30: begin\r
+ conso := 'M';\r
+ if random( 5 ) = 0 then\r
+ begin\r
+ indic := I_ESM;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 31..33: begin\r
+ conso := 'N';\r
+ if random( 5 ) = 0 then\r
+ begin\r
+ indic := I_ESN;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 34..36: conso := 'P';\r
+ 37..38: begin\r
+ conso := 'Q';\r
+ indic := I_ESQ;\r
+ end;\r
+ 39..41: begin\r
+ conso := 'R';\r
+ if random( 3 ) = 0 then\r
+ begin\r
+ indic := I_ESR;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 42..44: conso := 'S';\r
+ 45..47: begin\r
+ conso := 'T';\r
+ if random( 10 ) = 0 then\r
+ begin\r
+ indic := I_EST;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 48..50: conso := 'V';\r
+ 51: conso := 'W';\r
+ 52: conso := 'X';\r
+ 53: conso := 'Y';\r
+ 54: conso := 'Z';\r
+ end; { case random( 55 ) of }\r
+\r
+ end; { case indic of }\r
+ end; { procedimiento }\r
+\r
+(*********************************************************)\r
+\r
+ function GetRNDApellido( max, min: integer ): APELLIDO;\r
+\r
+ var\r
+ tam, i: integer;\r
+ aux: char;\r
+ apel: APELLIDO;\r
+ indic: INDICADOR;\r
+ proxl: TIPO_LETRA;\r
+\r
+ begin\r
+ if max > MAX_APE then max := MAX_APE;\r
+ tam := random( max + 1 ) + min;\r
+ indic := I_NADA;\r
+ apel := '';\r
+ if random( 5 ) = 0 then proxl := TL_VOCAL\r
+ else proxl := TL_CONSO;\r
+ for i := 1 to tam do\r
+ begin\r
+ if proxl = TL_CONSO then GetRNDConsonante( indic, proxl, aux )\r
+ else GetRNDVocal( indic, proxl, aux );\r
+ apel := apel + aux;\r
+ end;\r
+ GetRNDApellido := apel;\r
+ end;\r
+\r
+var\r
+ n, i: integer;\r
+ arch: text;\r
+ ap: APELLIDO;\r
+ dni: DOCUMENTO;\r
+\r
+begin\r
+ randomize;\r
+ n := 1000;\r
+ assign( arch, 'DATOS.TXT' );\r
+ rewrite( arch );\r
+ dni := 10000000 + (random( 15000 ) * 100);\r
+\r
+ for i := 1 to n do\r
+ begin\r
+ ap := GetRNDApellido( 7, 4 );\r
+ dni := dni + random( 50000 ) + 1;\r
+ writeln( arch, ap );\r
+ writeln( arch, dni );\r
+ writeln( arch );\r
+ end;\r
+ close( arch );\r
+end.\r
--- /dev/null
+program Comparacion_De_Algoritmos_De_Ordenamiento;\r
+\r
+uses\r
+ CRT, DOS;\r
+\r
+const\r
+ MAX_APE = 15;\r
+\r
+type\r
+ APELLIDO = string[MAX_APE];\r
+ DOCUMENTO = longint;\r
+ PERSONA = record\r
+ ap: APELLIDO;\r
+ dni: DOCUMENTO;\r
+ end;\r
+ HORA = record\r
+ h,\r
+ m,\r
+ s,\r
+ c: longint;\r
+ end;\r
+ TABLA = array[1..1000] of PERSONA;\r
+ TIPO_LETRA = ( TL_VOCAL, TL_CONSO );\r
+ TIPO_VOCAL = ( TV_AEIOU, TV_EI );\r
+ INDICADOR = ( I_NADA, I_ESB, I_ESC, I_ESF, I_ESG, I_ESL, I_ESM, I_ESN, I_ESQ, I_ESQU, I_ESR, I_EST );\r
+\r
+(*********************************************************)\r
+\r
+ procedure CargarArchivo( var datos: TABLA; var ar: text; tam: integer );\r
+\r
+ var\r
+ i: integer;\r
+\r
+ begin\r
+ for i:= 1 to tam do\r
+ begin\r
+ writeln( ar, datos[i].ap );\r
+ writeln( ar, datos[i].dni );\r
+ writeln( ar );\r
+ end;\r
+ end;\r
+\r
+(*********************************************************)\r
+(*********************************************************)\r
+\r
+ procedure MenuEvaluar( var datos: TABLA; var arch: text );\r
+\r
+ (*********************************************************)\r
+\r
+ procedure NoExisteArch;\r
+\r
+ begin\r
+ clrscr;\r
+ gotoxy( 20, 10 );\r
+ textcolor( LightMagenta + Blink );\r
+ writeln( 'ERROR: No existe el archivo a evaluar!' );\r
+ textcolor( LightGray );\r
+ writeln;\r
+ writeln( ' Creelo seleccionando la opci¢n 1 del Men£ Principal.' );\r
+ delay( 4000 );\r
+ end; { procedure NoExisteArch }\r
+\r
+ (*********************************************************)\r
+\r
+ function ExisteArchivo( nombre: String ): boolean;\r
+ { funcion extrido de la ayuda del pascal }\r
+ var\r
+ arch: text;\r
+\r
+ begin\r
+ {$I-}\r
+ Assign( arch, nombre );\r
+ FileMode := 0; { Solo lectura }\r
+ Reset( arch );\r
+ Close( arch );\r
+ {$I+}\r
+ ExisteArchivo := (IOResult = 0) and (nombre <> '');\r
+ end; { function ExisteArchivo }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure CargarTabla( var ar: text; var datos: TABLA; tam: integer );\r
+\r
+ var\r
+ i: integer;\r
+ void: string[2];\r
+\r
+ begin\r
+ for i:= 1 to tam do\r
+ begin\r
+ readln( ar, datos[i].ap );\r
+ readln( ar, datos[i].dni );\r
+ readln( ar, void );\r
+ end;\r
+ end; { procedure CargarTabla }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure Intercambiar( var a, b: PERSONA; var int: longint );\r
+\r
+ var\r
+ aux: PERSONA;\r
+\r
+ begin\r
+ int := int + 1;\r
+ aux := a;\r
+ a := b;\r
+ b := aux;\r
+ { delay( 1 );}\r
+ end; { procedure Intercambiar }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure GetHora( var hor: HORA );\r
+\r
+ var\r
+ h, m, s, c: word;\r
+\r
+ begin\r
+ gettime( h, m, s, c );\r
+ hor.h := h;\r
+ hor.m := m;\r
+ hor.s := s;\r
+ hor.c := c;\r
+ end; { procedure GetHora }\r
+\r
+ (*********************************************************)\r
+\r
+ function GetTiempo( h1, h2: HORA ): longint;\r
+\r
+ var\r
+ t: longint;\r
+ aux: HORA;\r
+\r
+ begin\r
+ if h1.h <> h2.h then { pone al menor como h2 y al mayor como h1 }\r
+ begin\r
+ if h1.h < h2.h then\r
+ begin\r
+ aux := h1;\r
+ h1 := h2;\r
+ h2 := aux;\r
+ end\r
+ end\r
+ else if h1.m <> h2.m then\r
+ begin\r
+ if h1.m < h2.m then\r
+ begin\r
+ aux := h1;\r
+ h1 := h2;\r
+ h2 := aux;\r
+ end\r
+ end\r
+ else if h1.s <> h2.s then\r
+ begin\r
+ if h1.s < h2.s then\r
+ begin\r
+ aux := h1;\r
+ h1 := h2;\r
+ h2 := aux;\r
+ end\r
+ end\r
+ else if h1.c <> h2.c then\r
+ if h1.c < h2.c then\r
+ begin\r
+ aux := h1;\r
+ h1 := h2;\r
+ h2 := aux;\r
+ end;\r
+ t := ( ( ( h1.h - h2.h ) * 60 + ( h1.m - h2.m ) ) * 60 + ( h1.s - h2.s ) ) * 100 + ( h1.c - h2.c );\r
+ GetTiempo := t;\r
+ end; { function GetTiempo }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure EvaluarCre( var datos: TABLA; var arch: text );\r
+\r
+ (*********************************************************)\r
+\r
+ procedure BubbleSort( var arch: text; var datos: TABLA; tam: integer;\r
+ var comparaciones: longint; var intercambios: longint; var tiempo: longint );\r
+\r
+ var\r
+ i, j: integer;\r
+ h1, h2: HORA;\r
+\r
+ begin\r
+ GetHora( h1 );\r
+ comparaciones := 0;\r
+ intercambios := 0;\r
+ reset( arch );\r
+ CargarTabla( arch, datos, 1000 );\r
+ close( arch );\r
+ for i := tam - 1 downto 1 do\r
+ begin\r
+ for j := tam - 1 downto 1 do\r
+ begin\r
+ comparaciones := comparaciones + 1;\r
+ { delay( 1 );}\r
+ if datos[j].ap > datos[j+1].ap then\r
+ Intercambiar( datos[j], datos[j+1], intercambios);\r
+ end;\r
+ end;\r
+ GetHora( h2 );\r
+ tiempo := GetTiempo( h1, h2 );\r
+ end; { procedure BubbleSort }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure BubbleSortMej( var arch: text; var datos: TABLA; tam: integer;\r
+ var comparaciones: longint; var intercambios: longint; var tiempo: longint );\r
+\r
+ var\r
+ huboint: boolean;\r
+ i, n: integer;\r
+ h1, h2: HORA;\r
+\r
+ begin\r
+ GetHora( h1 );\r
+ comparaciones := 0;\r
+ intercambios := 0;\r
+ n := 1;\r
+ reset( arch );\r
+ CargarTabla( arch, datos, 1000 );\r
+ close( arch );\r
+ huboint := true;\r
+ while huboint do\r
+ begin\r
+ huboint := false;\r
+ for i := tam - 1 downto n do\r
+ begin\r
+ comparaciones := comparaciones + 1;\r
+ { delay( 1 );}\r
+ if datos[i].ap > datos[i+1].ap then\r
+ begin\r
+ Intercambiar( datos[i], datos[i+1], intercambios);\r
+ huboint := true;\r
+ end;\r
+ end;\r
+ n := n + 1;\r
+ end;\r
+ GetHora( h2 );\r
+ tiempo := GetTiempo( h1, h2 );\r
+ end; { procedure BubbleSortMej }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure SelectionSort( var arch: text; var datos: TABLA; tam: integer;\r
+ var comparaciones: longint; var intercambios: longint; var tiempo: longint );\r
+ var\r
+ i, sel, n: integer;\r
+ hubosel: boolean;\r
+ h1, h2: HORA;\r
+\r
+ begin\r
+ GetHora( h1 );\r
+ comparaciones := 0;\r
+ intercambios := 0;\r
+ reset( arch );\r
+ CargarTabla( arch, datos, 1000 );\r
+ close( arch );\r
+ for n := 1 to tam - 1 do\r
+ begin\r
+ hubosel := false;\r
+ sel := n;\r
+ for i := n + 1 to tam do\r
+ begin\r
+ comparaciones := comparaciones + 1;\r
+ { delay( 1 ); }\r
+ if datos[sel].ap > datos[i].ap then\r
+ begin\r
+ sel := i;\r
+ hubosel := true;\r
+ end;\r
+ end;\r
+ if hubosel then Intercambiar( datos[n], datos[sel], intercambios);\r
+ end;\r
+ GetHora( h2 );\r
+ tiempo := GetTiempo( h1, h2 );\r
+ end; { procedure SelectionSort }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure QuickSort( var arch: text; var datos: TABLA; tam: integer;\r
+ var comparaciones: longint; var intercambios: longint; var tiempo: longint );\r
+\r
+ procedure QSort( var datos: TABLA; min, max: integer;\r
+ var comp: longint; var int: longint );\r
+\r
+ var\r
+ i, j: integer;\r
+ sel: PERSONA;\r
+ flag: boolean;\r
+\r
+ begin\r
+ sel := datos[( min + max ) div 2];\r
+ i := min;\r
+ j := max;\r
+ repeat\r
+ comp := comp + 1;\r
+ { delay( 1 );}\r
+ flag := false;\r
+ while datos[i].ap < sel.ap do\r
+ begin\r
+ if flag then begin\r
+ comp := comp + 1;\r
+ { delay( 1 );}\r
+ end\r
+ else flag := true;\r
+ i := i + 1;\r
+ end;\r
+ comp := comp + 1;\r
+ { delay( 1 );}\r
+ flag := false;\r
+ while datos[j].ap > sel.ap do\r
+ begin\r
+ if flag then begin\r
+ comp := comp + 1;\r
+ { delay( 1 );}\r
+ end\r
+ else flag := true;\r
+ j := j - 1;\r
+ end;\r
+ if i <= j then\r
+ begin\r
+ if i < j then Intercambiar( datos[i], datos[j], int );\r
+ i := i + 1;\r
+ j := j - 1;\r
+ end;\r
+ until i > j;\r
+ if min < j then QSort( datos, min, j, comp, int);\r
+ if i < max then QSort( datos, i, max, comp, int);\r
+ end; { procedure QSort }\r
+\r
+ (*********************************************************)\r
+\r
+ var\r
+ h1, h2: HORA;\r
+\r
+ begin { procedure QuickSort }\r
+ GetHora( h1 );\r
+ comparaciones := 0;\r
+ intercambios := 0;\r
+ reset( arch );\r
+ CargarTabla( arch, datos, 1000 );\r
+ close( arch );\r
+ QSort( datos, 1, 1000, comparaciones, intercambios );\r
+ GetHora( h2 );\r
+ tiempo := GetTiempo( h1, h2 );\r
+ rewrite( arch );\r
+ CargarArchivo( datos, arch, 1000 );\r
+ close( arch );\r
+ end; { procedure QuickSort }\r
+\r
+ (*********************************************************)\r
+\r
+ var { procedure EvaluarCre }\r
+ bsComp, bsInt, bsTiem,\r
+ bsmComp, bsmInt, bsmTiem,\r
+ ssComp, ssInt, ssTiem,\r
+ qsComp, qsInt, qsTiem: longint;\r
+ info: text;\r
+\r
+ begin\r
+ assign( info, 'INFORME.TXT' );\r
+ if ExisteArchivo( 'DATOS.TXT' ) then\r
+ begin\r
+ BubbleSort( arch, datos, 1000, bsComp, bsInt, bsTiem );\r
+ BubbleSortMej( arch, datos, 1000, bsmComp, bsmInt, bsmTiem );\r
+ SelectionSort( arch, datos, 1000, ssComp, ssInt, ssTiem );\r
+ QuickSort( arch, datos, 1000, qsComp, qsInt, qsTiem );\r
+ rewrite( info );\r
+ writeln( info, 'Bubble Sort:' );\r
+ writeln( info, ' Comparaciones: ', bsComp: 1 );\r
+ writeln( info, ' Intercambios: ', bsInt: 1 );\r
+ writeln( info, ' Tiempo (seg): ', bsTiem / 100: 2: 2 );\r
+ writeln( info );\r
+ writeln( info, 'Bubble Sort Mejorado:' );\r
+ writeln( info, ' Comparaciones: ', bsmComp: 1 );\r
+ writeln( info, ' Intercambios: ', bsmInt: 1 );\r
+ writeln( info, ' Tiempo (seg): ', bsmTiem / 100: 2: 2 );\r
+ writeln( info );\r
+ writeln( info, 'Selection Sort:' );\r
+ writeln( info, ' Comparaciones: ', ssComp: 1 );\r
+ writeln( info, ' Intercambios: ', ssInt: 1 );\r
+ writeln( info, ' Tiempo (seg): ', ssTiem / 100: 2: 2 );\r
+ writeln( info );\r
+ writeln( info, 'Quick Sort:' );\r
+ writeln( info, ' Comparaciones: ', qsComp: 1 );\r
+ writeln( info, ' Intercambios: ', qsInt: 1 );\r
+ writeln( info, ' Tiempo (seg): ', qsTiem / 100: 2: 2 );\r
+ writeln( info );\r
+ close( info );\r
+ end\r
+ else\r
+ NoExisteArch;\r
+ end; { procedure EvaluarCre }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure EvaluarDec( var datos: TABLA; var arch: text );\r
+\r
+ var nada: integer;\r
+\r
+ begin\r
+ for nada := 1 to 1000 do\r
+ writeln( datos[nada].ap, ' ', datos[nada].dni );\r
+ delay( 3000 );\r
+ end;\r
+\r
+ (*********************************************************)\r
+\r
+ var { procedure MenuEvaluar }\r
+ tecla: char;\r
+\r
+ begin\r
+ clrscr;\r
+ textcolor( Yellow );\r
+ gotoxy( 19, 3 );\r
+ writeln( 'COMPARACION DE ALGORITMOS DE ORDENAMIENTO' );\r
+ gotoxy( 19, 4 );\r
+ writeln( '~~~~~~~~~~~ ~~ ~~~~~~~~~~ ~~ ~~~~~~~~~~~~' );\r
+ textcolor( LightCyan );\r
+ gotoxy( 1, 7 );\r
+ writeln( ' Evaluar Algoritmos:' );\r
+ writeln( ' ------- ----------' );\r
+ textcolor( LightGray );\r
+ writeln;\r
+ writeln;\r
+ writeln( ' 1.- Ordenando en forma creciente.' );\r
+ writeln( ' 2.- Ordenando en forma decreciente.' );\r
+ writeln( ' 0.- Men£ Anterior.' );\r
+ gotoxy( 1, 20 );\r
+ textcolor( White );\r
+ write( ' Ingrese su opci¢n: ' );\r
+ textcolor( Yellow );\r
+ tecla := readkey;\r
+ while ( ( tecla < '1' ) or ( tecla > '2' ) ) and ( tecla <> '0' ) do\r
+ begin\r
+ textcolor( White );\r
+ gotoxy( 1, 20 );\r
+ write( ' Ingrese su opci¢n (1, 2 o 0): ' );\r
+ textcolor( Yellow );\r
+ tecla := readkey;\r
+ end;\r
+ case tecla of\r
+ '1': if ExisteArchivo( 'DATOS.TXT' ) then EvaluarCre( datos, arch )\r
+ else NoExisteArch;\r
+ '2': if ExisteArchivo( 'DATOS.TXT' ) then EvaluarDec( datos, arch )\r
+ else NoExisteArch;\r
+ '0': ;\r
+ end;\r
+ end;\r
+\r
+(*********************************************************)\r
+(*********************************************************)\r
+\r
+ procedure MenuGenerar( var arch: text );\r
+\r
+ (*********************************************************)\r
+\r
+ function GetRNDApellido( max, min: integer ): APELLIDO;\r
+\r
+ (*********************************************************)\r
+\r
+ function GetVocal( tipo: TIPO_VOCAL ): char;\r
+\r
+ var\r
+ valor: integer;\r
+\r
+ begin\r
+ if tipo = TV_AEIOU then valor := random( 16 )\r
+ else valor := random( 6 ) + 5;\r
+ case valor of\r
+ 0..4: GetVocal := 'A';\r
+ 5..7: GetVocal := 'E';\r
+ 8..10: GetVocal := 'I';\r
+ 11..13: GetVocal := 'O';\r
+ 14..15: GetVocal := 'U';\r
+ end;\r
+ end; { function GetVocal }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure GetRNDVocal( var indic: INDICADOR; var proxl: TIPO_LETRA; var vocal: char );\r
+\r
+ var\r
+ valor: integer;\r
+\r
+ begin\r
+ case indic of\r
+ I_ESQ:\r
+ begin\r
+ vocal := 'U';\r
+ indic := I_ESQU;\r
+ proxl := TL_VOCAL;\r
+ end;\r
+ I_ESQU:\r
+ begin\r
+ vocal := GetVocal( TV_EI );\r
+ indic := I_NADA;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ else\r
+ begin\r
+ vocal := GetVocal( TV_AEIOU );\r
+ indic := I_NADA;\r
+ if random( 40 ) = 0 then proxl := TL_VOCAL\r
+ else proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ end; { procedure GetRNDVocal }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure GetRNDConsonante( var indic: INDICADOR; var proxl: TIPO_LETRA; var conso: char );\r
+\r
+ var\r
+ valor: integer;\r
+\r
+ begin\r
+ proxl := TL_VOCAL;\r
+ indic := I_NADA;\r
+\r
+ case indic of\r
+ I_ESF, I_ESR, I_ESG, I_EST: conso := 'R';\r
+ I_ESB: case random( 2 ) of\r
+ 0: conso := 'R';\r
+ 1: conso := 'L';\r
+ end;\r
+ I_ESC: case random( 4 ) of\r
+ 0: conso := 'C';\r
+ 1: conso := 'H';\r
+ 2: conso := 'R';\r
+ 3: conso := 'L';\r
+ end;\r
+ I_ESL: case random( 6 ) of\r
+ 0: conso := 'T';\r
+ 1..5: conso := 'L';\r
+ end;\r
+ I_ESM: case random( 3 ) of\r
+ 0: conso := 'P';\r
+ 1: conso := 'B';\r
+ 2: conso := 'L';\r
+ end;\r
+ I_ESN: case random( 3 ) of\r
+ 0: conso := 'R';\r
+ 1: conso := 'V';\r
+ 2: conso := 'C';\r
+ end;\r
+ else case random( 55 ) of\r
+ 0..3: begin\r
+ conso := 'B';\r
+ if random( 10 ) = 0 then begin\r
+ indic := I_ESB;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 4..7: begin\r
+ conso := 'C';\r
+ if random( 5 ) = 0 then begin\r
+ indic := I_ESC;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 8..11: conso := 'D';\r
+ 12..14: begin\r
+ conso := 'F';\r
+ if random( 10 ) = 0 then begin\r
+ indic := I_ESF;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 15..17: begin\r
+ conso := 'G';\r
+ if random( 5 ) = 0 then\r
+ begin\r
+ indic := I_ESG;\r
+ if random( 4 ) = 0 then proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 18..19: conso := 'H';\r
+ 20..22: conso := 'J';\r
+ 23..24: conso := 'K';\r
+ 25..27: begin\r
+ conso := 'L';\r
+ if random( 15 ) = 0 then\r
+ begin\r
+ indic := I_ESL;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 28..30: begin\r
+ conso := 'M';\r
+ if random( 5 ) = 0 then\r
+ begin\r
+ indic := I_ESM;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 31..33: begin\r
+ conso := 'N';\r
+ if random( 5 ) = 0 then\r
+ begin\r
+ indic := I_ESN;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 34..36: conso := 'P';\r
+ 37..38: begin\r
+ conso := 'Q';\r
+ indic := I_ESQ;\r
+ end;\r
+ 39..41: begin\r
+ conso := 'R';\r
+ if random( 3 ) = 0 then\r
+ begin\r
+ indic := I_ESR;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 42..44: conso := 'S';\r
+ 45..47: begin\r
+ conso := 'T';\r
+ if random( 10 ) = 0 then\r
+ begin\r
+ indic := I_EST;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 48..50: conso := 'V';\r
+ 51: conso := 'W';\r
+ 52: conso := 'X';\r
+ 53: conso := 'Y';\r
+ 54: conso := 'Z';\r
+ end; { case random( 55 ) of }\r
+\r
+ end; { case indic of }\r
+ end; { procedure GetRNDConsonante }\r
+\r
+ (*********************************************************)\r
+\r
+ var { function GetRNDApellido }\r
+ tam, i: integer;\r
+ aux: char;\r
+ apel: APELLIDO;\r
+ indic: INDICADOR;\r
+ proxl: TIPO_LETRA;\r
+\r
+ begin\r
+ if max > MAX_APE then max := MAX_APE;\r
+ tam := random( max + 1 ) + min;\r
+ indic := I_NADA;\r
+ apel := '';\r
+ if random( 5 ) = 0 then proxl := TL_VOCAL\r
+ else proxl := TL_CONSO;\r
+ for i := 1 to tam do\r
+ begin\r
+ if proxl = TL_CONSO then GetRNDConsonante( indic, proxl, aux )\r
+ else GetRNDVocal( indic, proxl, aux );\r
+ apel := apel + aux;\r
+ end;\r
+ GetRNDApellido := apel;\r
+ end; { function GetRNDApellido }\r
+\r
+ (*********************************************************)\r
+\r
+ function GetRNDLetra( min, max: char ): char;\r
+\r
+ begin\r
+ GetRNDLetra := chr( random( ord( max ) - ord( min ) + 1 ) + ord( min ) );\r
+ end;\r
+\r
+ (*********************************************************)\r
+\r
+ procedure GetOrdApellidos( var ar: text; cant: integer );\r
+\r
+ var\r
+ mil: boolean;\r
+ letra, letra1: char;\r
+ i, j, veces: integer;\r
+ dni: DOCUMENTO;\r
+ ap, ape, apel: APELLIDO;\r
+\r
+ begin\r
+ mil := false;\r
+ if cant = 1000 then mil := true;\r
+ dni := 10000000 + (random( 15000 ) * 100);\r
+ ap := '';\r
+ ape := '';\r
+ apel := '';\r
+ for letra := 'A' to 'Z' do\r
+ begin\r
+ ap := letra;\r
+ for letra1 := 'A' to 'Z' do\r
+ begin\r
+ if mil then\r
+ case letra of\r
+ 'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T':\r
+ case letra1 of\r
+ 'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T', 'Z': veces := 2;\r
+ else veces := 1;\r
+ end;\r
+ else case letra1 of\r
+ 'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T': veces := 2;\r
+ else veces := 1;\r
+ end;\r
+ end\r
+ else\r
+ case letra of\r
+ 'A', 'B', 'C', 'D', 'E', 'F', 'I', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T', 'V':\r
+ case letra1 of\r
+ 'D', 'F', 'G', 'H', 'I', 'J', 'K', 'U', 'V': veces := 2;\r
+ else veces := 1;\r
+ end;\r
+ else case letra1 of\r
+ 'D', 'F', 'G', 'H', 'I', 'J', 'K', 'U': veces := 2;\r
+ else veces := 1;\r
+ end;\r
+ end;\r
+ ape := ap + letra1;\r
+ for j := 1 to veces do\r
+ begin\r
+ if j = 1 then apel := ape + GetRNDLetra( 'A', 'M' ) + GetRNDApellido( 6, 1 )\r
+ else apel := ape + GetRNDLetra( 'N', 'Z' ) + GetRNDApellido( 6, 1 );\r
+ dni := dni + random( 50000 ) + 1;\r
+ writeln( ar, apel );\r
+ writeln( ar, dni );\r
+ writeln( ar );\r
+ apel := '';\r
+ end;\r
+\r
+ ape := '';\r
+\r
+ end; { for letra1 := 'A' to 'Z' do }\r
+\r
+ ap := '';\r
+\r
+ end; { for letra := 'A' to 'Z' do }\r
+\r
+ end; { procedure GetOrdApellidos }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure GetInvOrdApellidos( var ar: text; cant: integer );\r
+\r
+ var\r
+ mil: boolean;\r
+ letra, letra1: char;\r
+ i, j, veces: integer;\r
+ dni: DOCUMENTO;\r
+ ap, ape, apel: APELLIDO;\r
+\r
+ begin\r
+ mil := false;\r
+ if cant = 1000 then mil := true;\r
+ dni := 34000000 + (random( 15000 ) * 100);\r
+ ap := '';\r
+ ape := '';\r
+ apel := '';\r
+ for letra := 'Z' downto 'A' do\r
+ begin\r
+ ap := letra;\r
+ for letra1 := 'Z' downto 'A' do\r
+ begin\r
+ if mil then\r
+ case letra of\r
+ 'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T':\r
+ case letra1 of\r
+ 'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T', 'Z': veces := 2;\r
+ else veces := 1;\r
+ end;\r
+ else case letra1 of\r
+ 'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T': veces := 2;\r
+ else veces := 1;\r
+ end;\r
+ end\r
+ else\r
+ case letra of\r
+ 'A', 'B', 'C', 'D', 'E', 'F', 'I', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T', 'V':\r
+ case letra1 of\r
+ 'D', 'F', 'G', 'H', 'I', 'J', 'K', 'U', 'V': veces := 2;\r
+ else veces := 1;\r
+ end;\r
+ else case letra1 of\r
+ 'D', 'F', 'G', 'H', 'I', 'J', 'K', 'U': veces := 2;\r
+ else veces := 1;\r
+ end;\r
+ end;\r
+ ape := ap + letra1;\r
+ for j := 1 to veces do\r
+ begin\r
+ if j <> 1 then apel := ape + GetRNDLetra( 'A', 'M' ) + GetRNDApellido( 6, 1 )\r
+ else apel := ape + GetRNDLetra( 'N', 'Z' ) + GetRNDApellido( 6, 1 );\r
+ dni := dni - random( 40000 ) - 1;\r
+ writeln( ar, apel );\r
+ writeln( ar, dni );\r
+ writeln( ar );\r
+ apel := '';\r
+ end;\r
+\r
+ ape := '';\r
+\r
+ end; { for letra1 := 'A' to 'Z' do }\r
+\r
+ ap := '';\r
+\r
+ end; { for letra := 'A' to 'Z' do }\r
+\r
+ end; { GetInvOrdApellidos }\r
+\r
+\r
+ (*********************************************************)\r
+\r
+ procedure GenerarRND( var arch: text; n: integer; reabrir: boolean );\r
+\r
+ var\r
+ i: integer;\r
+ ap: APELLIDO;\r
+ dni: DOCUMENTO;\r
+\r
+ begin\r
+ if reabrir then rewrite( arch );\r
+ dni := 10000000 + (random( 15000 ) * 100);\r
+\r
+ for i := 1 to n do\r
+ begin\r
+ ap := GetRNDApellido( 8, 4 );\r
+ dni := dni + random( 50000 ) + 1;\r
+ writeln( arch, ap );\r
+ writeln( arch, dni );\r
+ writeln( arch );\r
+ end;\r
+ if reabrir then close( arch );\r
+ end; { procedure GenerarRND }\r
+\r
+ (*********************************************************)\r
+\r
+ procedure GenerarOrd( var arch: text; n: integer; reabrir: boolean );\r
+\r
+ begin\r
+ if reabrir then rewrite( arch );\r
+ GetOrdApellidos( arch, n );\r
+ if reabrir then close( arch );\r
+ end;\r
+\r
+ (*********************************************************)\r
+\r
+ procedure GenerarOrdDec( var arch: text; n: integer; reabrir: boolean );\r
+\r
+ begin\r
+ if reabrir then rewrite( arch );\r
+ GetInvOrdApellidos( arch, n );\r
+ if reabrir then close( arch );\r
+ end;\r
+\r
+ (*********************************************************)\r
+\r
+ procedure Generar90Ord( var arch: text );\r
+\r
+ begin\r
+ rewrite( arch );\r
+ GenerarOrd( arch, 900, false );\r
+ GenerarRND( arch, 100, false );\r
+ close( arch );\r
+ end;\r
+\r
+ (*********************************************************)\r
+\r
+ procedure Generar90OrdDec( var arch: text );\r
+\r
+ begin\r
+ rewrite( arch );\r
+ GenerarOrdDec( arch, 900, false );\r
+ GenerarRND( arch, 100, false );\r
+ close( arch );\r
+ end;\r
+\r
+ (*********************************************************)\r
+\r
+ var { procedure MenuGenerar }\r
+ tecla: char;\r
+\r
+ begin\r
+ clrscr;\r
+ textcolor( Yellow );\r
+ gotoxy( 19, 3 );\r
+ writeln( 'COMPARACION DE ALGORITMOS DE ORDENAMIENTO' );\r
+ gotoxy( 19, 4 );\r
+ writeln( '~~~~~~~~~~~ ~~ ~~~~~~~~~~ ~~ ~~~~~~~~~~~~' );\r
+ textcolor( LightCyan );\r
+ gotoxy( 1, 7 );\r
+ writeln( ' Generar Archivo (''DATOS.TXT''):' );\r
+ writeln( ' ------- ------- -------------' );\r
+ textcolor( LightGray );\r
+ writeln;\r
+ writeln;\r
+ writeln( ' 1.- Con datos desordenados.' );\r
+ writeln( ' 2.- Con datos en orden creciente (APELLIDO, DNI).' );\r
+ writeln( ' 3.- Con datos en orden decreciente (APELLIDO, DNI).' );\r
+ writeln( ' 4.- Con 90% datos en orden creciente (APELLIDO, DNI) + 10% desordenado.' );\r
+ writeln( ' 5.- Con 90% datos en orden decreciente (APELLIDO, DNI) + 10% desordenado.' );\r
+ writeln( ' 0.- Men£ Anterior.' );\r
+ gotoxy( 1, 20 );\r
+ textcolor( White );\r
+ write( ' Ingrese su opci¢n: ' );\r
+ textcolor( Yellow );\r
+ tecla := readkey;\r
+ while ( ( tecla < '1' ) or ( tecla > '5' ) ) and ( tecla <> '0' ) do\r
+ begin\r
+ textcolor( White );\r
+ gotoxy( 1, 20 );\r
+ write( ' Ingrese su opci¢n (1 a 5 o 0): ' );\r
+ textcolor( Yellow );\r
+ tecla := readkey;\r
+ end;\r
+ case tecla of\r
+ '1': GenerarRND( arch, 1000, true );\r
+ '2': GenerarOrd( arch, 1000, true );\r
+ '3': GenerarOrdDec( arch, 1000, true );\r
+ '4': Generar90Ord( arch );\r
+ '5': Generar90OrdDec( arch );\r
+ '0': ;\r
+ end;\r
+ end; { procedure MenuGenerar }\r
+\r
+(*********************************************************)\r
+\r
+{ procedure MenuPrincipal( var arch: text; var datos: TABLA );}\r
+\r
+ var\r
+ datos: TABLA;\r
+ arch: text;\r
+ tecla: char;\r
+ salir: boolean;\r
+\r
+ begin\r
+ randomize;\r
+ assign( arch, 'DATOS.TXT' );\r
+ salir := false;\r
+ textbackground( Blue );\r
+\r
+ while not salir do\r
+ begin\r
+ clrscr;\r
+ textcolor( Yellow );\r
+ gotoxy( 19, 3 );\r
+ writeln( 'COMPARACION DE ALGORITMOS DE ORDENAMIENTO' );\r
+ gotoxy( 19, 4 );\r
+ writeln( '~~~~~~~~~~~ ~~ ~~~~~~~~~~ ~~ ~~~~~~~~~~~~' );\r
+ gotoxy( 1, 7 );\r
+ textcolor( LightCyan );\r
+ writeln( ' Men£ Principal:' );\r
+ writeln( ' ---- ---------' );\r
+ textcolor( LightGray );\r
+ writeln;\r
+ writeln;\r
+ writeln( ' 1.- Generar Archivo (''DATOS.TXT'').' );\r
+ writeln( ' 2.- Evaluar Algoritmos.' );\r
+ writeln( ' 0.- Salir.' );\r
+ gotoxy( 1, 20 );\r
+ textcolor( White );\r
+ write( ' Ingrese su opci¢n: ' );\r
+ textcolor( Yellow );\r
+ tecla := readkey;\r
+ while ( ( tecla < '1' ) or ( tecla > '2' ) ) and ( tecla <> '0' ) do\r
+ begin\r
+ textcolor( White );\r
+ gotoxy( 1, 20 );\r
+ write( ' Ingrese su opci¢n (1, 2 o 0): ' );\r
+ textcolor( Yellow );\r
+ tecla := readkey;\r
+ end;\r
+ case tecla of\r
+ '1': MenuGenerar( arch );\r
+ '2': MenuEvaluar( datos, arch );\r
+ '0': salir := true;\r
+ end;\r
+ end;\r
+ writeln;\r
+ NormVideo;\r
+ clrscr;\r
+ writeln;\r
+ textcolor( white );\r
+ writeln( ' COMPARACION DE ALGORITMOS DE ORDENAMIENTO versi¢n 1.1.0 <-o-o-> Luca - Soft' );\r
+ NormVideo;\r
+ writeln( ' Desarrollado por Leandro Lucarella para la Facultad de Ingenier¡a de la' );\r
+ writeln( ' Universidad de Buenos Aires. Consultas, sugerencias y/o reprobaciones a:' );\r
+ writeln;\r
+ textcolor( LightMagenta );\r
+ write( ' lluca@cnba.uba.ar' );\r
+ NormVideo;\r
+ write( ' o ' );\r
+ textcolor( LightMagenta );\r
+ writeln( 'lluca@geocities.com' );\r
+ NormVideo;\r
+ writeln;\r
+ writeln( ' (c) 1999 - Todos los derechos reservados.' );\r
+ delay( 750 );\r
+\r
+ {close( arch );}\r
+ end.
\ No newline at end of file
--- /dev/null
+program SortDemo ( Input, Output );\r
+uses\r
+ Crt;\r
+\r
+const\r
+ Max = 16;\r
+\r
+type\r
+ ArrayType = array [ 1 .. Max ] of Integer;\r
+\r
+var\r
+ A : ArrayType;\r
+\r
+ procedure DisplayArray ( var A : ArrayType );\r
+ var\r
+ I : Integer;\r
+ begin\r
+ ClrScr;\r
+ GotoXY( 1, 5 );\r
+ Write( '(' );\r
+ for I := 1 to Max do\r
+ begin\r
+ Write( A[ I ] : 3 );\r
+ if I <> Max then\r
+ Write( ',' )\r
+ else\r
+ Write( ')' )\r
+ end\r
+ end;\r
+\r
+ procedure FillArray( var A : ArrayType );\r
+ var\r
+ I : Integer;\r
+ begin\r
+ Randomize;\r
+ for I := 1 to Max do\r
+ A[ I ] := Random( 100 )\r
+ end;\r
+\r
+ procedure WriteLT ( Position : Integer;\r
+ Level : Integer );\r
+ begin\r
+ GoToXY( 4 * Position - 2, Level );\r
+ TextColor( White );\r
+ Write( ' >' );\r
+ TextColor( LightGray );\r
+ end;\r
+\r
+ procedure WriteBlank ( Position : Integer;\r
+ Level : Integer );\r
+ begin\r
+ GoToXY( 4 * Position - 2, Level );\r
+ TextColor( Black );\r
+ Write( ' ' );\r
+ TextColor( LightGray );\r
+ end;\r
+\r
+ procedure WriteColor ( I : Integer;\r
+ Value : Integer;\r
+ Color : Integer;\r
+ Row : Integer );\r
+ var\r
+ X : Integer;\r
+ begin\r
+ X := 4 * I - 2;\r
+ GoToXY( X, Row );\r
+ TextColor( Color );\r
+ Write( Value : 3 );\r
+ TextColor( LightGray )\r
+ end;\r
+\r
+ procedure WriteNormal ( I : Integer;\r
+ Value : Integer );\r
+ var\r
+ X : Integer;\r
+ begin\r
+ X := 4 * I - 2;\r
+ TextColor( LightGray );\r
+ GoToXY( X, 5 );\r
+ Write( Value : 3 )\r
+ end;\r
+\r
+\r
+ procedure MergeSort ( var A : ArrayType );\r
+ {V} var\r
+ {V} Level : Integer;\r
+ {V} I : Integer;\r
+\r
+ procedure Transfer( var F, T : ArrayType;\r
+ FromFirst,\r
+ FromLast,\r
+ ToFirst : Integer );\r
+ var\r
+ I : Integer;\r
+ begin\r
+ for I := FromFirst to FromLast do\r
+ T[ ToFirst + ( I - FromFirst ) ] := F[ I ];\r
+ end; {Transfer}\r
+\r
+ procedure Merge ( var A : ArrayType;\r
+ First,\r
+ Last : Integer );\r
+ var\r
+ MidPoint,\r
+ Left,\r
+ Right,\r
+ Count : Integer;\r
+ Temp : ArrayType;\r
+\r
+ {V} I : Integer;\r
+ {V} Ch : Char;\r
+\r
+ begin\r
+ Count := First;\r
+ MidPoint := ( First + Last ) div 2;\r
+ Left := First;\r
+ Right := Midpoint + 1;\r
+\r
+ {V} for I := First to Midpoint do\r
+ {V} WriteColor( I, A[ I ], LightRed, 5 );\r
+ {V} for I := Right to Last do\r
+ {V} WriteColor( I, A[ I ], LightBlue, 5 );\r
+ {V} Ch := ReadKey;\r
+\r
+ {V} for I := First to Last do\r
+ {V} WriteBlank( I, 5 );\r
+ {V} for I := First to Midpoint do\r
+ {V} WriteColor( I, A[ I ], LightRed, 10 );\r
+ {V} for I := Right to Last do\r
+ {V} WriteColor( I, A[ I ], LightBlue, 11 );\r
+ {V} Ch := ReadKey;\r
+\r
+ while ( Left <= Midpoint ) and ( Right <= Last ) do\r
+ begin\r
+ if A[ Left ] < A[ Right ] then\r
+ begin\r
+ Temp[ Count ] := A[ Left ];\r
+\r
+ {V} WriteColor( Count, A[ Left ], LightRed, 5 );\r
+ {V} WriteBlank( Left, 10 );\r
+ {V} Ch := ReadKey;\r
+\r
+ Inc( Left );\r
+ end\r
+ else\r
+ begin\r
+ Temp[ Count ] := A[ Right ];\r
+\r
+ {V} WriteColor( Count, A[ Right ], LightBlue, 5 );\r
+ {V} WriteBlank( Right, 11 );\r
+ {V} Ch := ReadKey;\r
+\r
+ Inc( Right );\r
+ end;\r
+ Inc( Count )\r
+ end;\r
+\r
+ if ( Left <= MidPoint ) then\r
+ {V} begin\r
+ Transfer( A, Temp, Left, Midpoint, Count );\r
+ {V} for I := Left to Midpoint do\r
+ {V} begin\r
+ {V} WriteColor( Count, A[ I ], LightRed, 5 );\r
+ {V} WriteBlank( I, 10 );\r
+ {V} Inc( Count );\r
+ {V} Ch := ReadKey;\r
+ {V} end;\r
+ {V} end\r
+\r
+ else\r
+ {V} begin\r
+ Transfer( A, Temp, Right, Last, Count );\r
+ {V} for I := Right to Last do\r
+ {V} begin\r
+ {V} WriteColor( Count, A[ I ], LightBlue, 5 );\r
+ {V} WriteBlank( I, 11 );\r
+ {V} Inc( Count );\r
+ {V} Ch := ReadKey;\r
+ {V} end;\r
+ {V} end;\r
+\r
+ Transfer( Temp, A, First, Last, First );\r
+\r
+\r
+ end; {Merge}\r
+\r
+ procedure MSort ( var A : ArrayType;\r
+ First,\r
+ Last : Integer );\r
+ var\r
+ MidPoint : Integer;\r
+ {V} I : Integer;\r
+ {V} Ch : Char;\r
+ begin\r
+ if First < Last then\r
+ begin\r
+ MidPoint := ( First + Last ) div 2;\r
+ MSort( A, First, MidPoint );\r
+\r
+ {V} for I := First to MidPoint do\r
+ {V} WriteLT( I, Level );\r
+ {V} Inc( Level );\r
+\r
+ MSort( A, MidPoint + 1, Last );\r
+\r
+ {V} for I := MidPoint + 1 to Last do\r
+ {V} WriteLT( I, Level );\r
+ {V} Inc( Level );\r
+\r
+ Merge( A, First, Last );\r
+\r
+ {V} for I := MidPoint + 1 to Last do\r
+ {V} begin\r
+ {V} WriteBlank( I, Level );\r
+ {V} WriteBlank( I, Level - 1 );\r
+ {V} WriteLT( I, Level - 2 );\r
+ {V} end;\r
+ {V} Dec( Level, 2 );\r
+\r
+ {V} for I := First to Last do\r
+ {V} WriteNormal( I, A[ I ] );\r
+ {V} Ch := ReadKey\r
+ end\r
+ end; {MSort}\r
+\r
+ begin\r
+ {V} Level := 6;\r
+\r
+ MSort( A, 1, Max );\r
+\r
+ {V} for I := 1 to Max do\r
+ {V} WriteLT( I, Level );\r
+ end; {MergeSort}\r
+\r
+begin\r
+ FillArray( A );\r
+ DisplayArray( A );\r
+ MergeSort( A );\r
+end.\r
+\r
--- /dev/null
+program SortDemo ( Input, Output );\r
+uses\r
+ Crt;\r
+\r
+const\r
+ Max = 12;\r
+\r
+type\r
+ ArrayType = array [ 1 .. Max ] of Integer;\r
+\r
+var\r
+ A : ArrayType;\r
+\r
+ procedure DisplayArray ( var A : ArrayType );\r
+ var\r
+ I : Integer;\r
+ begin\r
+ ClrScr;\r
+ GotoXY( 1, 5 );\r
+ Write( '(' );\r
+ for I := 1 to Max do\r
+ begin\r
+ Write( A[ I ] : 4 );\r
+ if I <> Max then\r
+ Write( ',' )\r
+ else\r
+ Write( ')' )\r
+ end\r
+ end;\r
+\r
+ procedure FillArray( var A : ArrayType );\r
+ var\r
+ I : Integer;\r
+ begin\r
+ Randomize;\r
+ for I := 1 to Max do\r
+ A[ I ] := Random( 100 )\r
+ end;\r
+\r
+\r
+ procedure WriteColor ( I : Integer;\r
+ Value : Integer;\r
+ Color : Integer );\r
+ var\r
+ X : Integer;\r
+ begin\r
+ X := 5 * I - 3;\r
+ GoToXY( X, 5 );\r
+ TextColor( Color );\r
+ Write( Value : 4 );\r
+ TextColor( LightGray )\r
+ end;\r
+\r
+ procedure WriteChColor ( I, J : Integer );\r
+ var\r
+ X : Integer;\r
+ begin\r
+ X := 5 * I - 1;\r
+ TextColor( White );\r
+ GotoXY( X, 7 );\r
+ Write( 'Lo' );\r
+ X := 5 * J - 1;\r
+ GoToXY( X, 7 );\r
+ Write( 'Hi' );\r
+ end;\r
+\r
+\r
+ procedure WriteNormal ( I : Integer;\r
+ Value : Integer );\r
+ var\r
+ X : Integer;\r
+ begin\r
+ X := 5 * I - 3;\r
+ TextColor( LightGray );\r
+ GoToXY( X, 5 );\r
+ Write( Value : 4 )\r
+ end;\r
+\r
+ procedure SetDisplay ( Pivot, Lo, Hi : Integer );\r
+ var\r
+ Ch : Char;\r
+ begin\r
+ GoToXY( 1, 9 );\r
+ TextColor( Green );\r
+ Write( 'Pivot Value = ', Pivot : 3 );\r
+ TextColor( LightRed );\r
+ Write( ' Lo Index = ', Lo : 3 );\r
+ TextColor( LightBlue );\r
+ Write( ' Hi Index = ', Hi : 3 );\r
+ WriteChColor( Lo, Hi );\r
+ Ch := ReadKey;\r
+ GoToXY( 1, 9 );\r
+ ClrEol;\r
+ GoToXY( 1, 7 );\r
+ Write(' ');\r
+ GoToXY( 1, 8 );\r
+ Write(' ');\r
+ GoToXY( 1, 9 );\r
+ Write(' ');\r
+ TextColor( LightGray );\r
+ end;\r
+\r
+ procedure QuickSort ( var A : ArrayType;\r
+ Lower,\r
+ Upper : Integer );\r
+\r
+ var\r
+ PivotPoint : Integer;\r
+ Ch : Char;\r
+ I : Integer;\r
+\r
+ PPos : Integer;\r
+\r
+ Procedure Partition ( var A : ArrayType;\r
+ Lo,\r
+ Hi : Integer;\r
+ var PivotPoint : Integer );\r
+ var\r
+ Pivot : Integer;\r
+ begin\r
+ Pivot := A[ Lo ];\r
+ PPos := Lo;\r
+ WriteColor( PPos, Pivot, Cyan + Black + Blink );\r
+ SetDisplay( Pivot, Lo, Hi );\r
+ while Lo < Hi do\r
+ begin\r
+ while ( Pivot < A[ Hi ] ) and ( Lo < Hi ) do\r
+ begin\r
+ Hi := Hi - 1;\r
+ SetDisplay( Pivot, Lo, Hi );\r
+ end;\r
+ if Hi <> Lo then\r
+ begin\r
+ WriteColor( Lo, A[ Hi ], LightRed );\r
+ A[ Lo ] := A[ Hi ];\r
+ if Lo = PPos then\r
+ begin\r
+ WriteColor( Hi, Pivot, Cyan + Black + Blink );\r
+ PPos := Hi;\r
+ end;\r
+ Lo := Lo + 1;\r
+ SetDisplay( Pivot, Lo, Hi );\r
+ end;\r
+\r
+ while ( Pivot > A[ Lo ] ) and ( Lo < Hi ) do\r
+ begin\r
+ Lo := Lo + 1;\r
+ SetDisplay( Pivot, Lo, Hi );\r
+ end;\r
+ if Hi <> Lo then\r
+ begin\r
+ WriteColor( Hi, A[ Lo ], LightBlue );\r
+ A[ Hi ] := A[ Lo ];\r
+ if Hi = PPos then\r
+ begin\r
+ WriteColor( Lo, Pivot, Cyan + Black + Blink );\r
+ PPos := Lo;\r
+ end;\r
+ Hi := Hi - 1;\r
+ SetDisplay( Pivot, Lo, Hi );\r
+ end;\r
+\r
+ end;\r
+ WriteColor( Hi, Pivot, Yellow );\r
+ Ch := ReadKey;\r
+ A[ Hi ] := Pivot;\r
+ PivotPoint := Hi\r
+ end;\r
+\r
+ begin\r
+ Partition( A, Lower, Upper, PivotPoint );\r
+ for I := Lower to Upper do\r
+ if I <> PivotPoint then\r
+ WriteNormal( I, A[ I ] );\r
+ if Lower < PivotPoint then\r
+ QuickSort( A, Lower, PivotPoint - 1 );\r
+ if Upper > PivotPoint then\r
+ QuickSort( A, PivotPoint + 1, Upper )\r
+ end;\r
+\r
+begin\r
+ FillArray( A );\r
+ DisplayArray( A );\r
+ QuickSort( A, 1, Max );\r
+ ClrScr\r
+end.\r
+\r
--- /dev/null
+program qsort;\r
+\r
+uses crt,dos;\r
+\r
+const\r
+ max = 1000;\r
+\r
+type\r
+ list = array[1..max] of integer;\r
+\r
+var\r
+ data : list;\r
+ i : integer;\r
+ h,m,s,hun : word;\r
+\r
+ procedure quicksort(var a : list; Lo,Hi: integer);\r
+\r
+ procedure sort(l,r : integer);\r
+\r
+ var\r
+ i,j,x,y : integer;\r
+\r
+ begin\r
+ i := l; j := r; x := a[( l+r ) div 2];\r
+ repeat\r
+ while a[i] < x do i := i+1;\r
+ while x < a[j] do j := j-1;\r
+ if i < j then\r
+ begin\r
+ y := a[i]; a[i] := a[j]; a[j] := y;\r
+ i := i+1; j := j-1;\r
+ end;\r
+ until i > j;\r
+ if l < j then sort( l , j );\r
+ if i < r then sort( i , r );\r
+ end;\r
+\r
+ begin {quicksort};\r
+ sort( Lo , Hi );\r
+ end;\r
+\r
+\r
+\r
+begin {qsort};\r
+ write('Now generating 1000 random numbers...');\r
+ randomize;\r
+ for i := 1 to max do data[i] := random(30000);\r
+ writeln;\r
+ writeln('Now sorting random numbers...');\r
+ gettime(h,m,s,hun);\r
+ writeln('Start time is : ',h,' : ',m,' : ',s,' : ',hun);\r
+ quicksort( data, 1, max );\r
+ writeln;\r
+ {for i := 1 to max do write(data[i] ); }\r
+ gettime(h,m,s,hun);\r
+ writeln('Finish time is : ',h,' : ',m,' : ',s,' : ',hun);\r
+end.
\ No newline at end of file
--- /dev/null
+PROCEDURE Shell( Var Item : DataArray; Count: Integer );\r
+\r
+CONST\r
+ N=5;\r
+\r
+VAR\r
+ I,J,K,S,Q : Integer ;\r
+ P : Array[1..N] OF Integer;\r
+ X : DataItem ;\r
+\r
+BEGIN\r
+ P[1] := 9;\r
+ P[2] := 5;\r
+ P[3] := 3;\r
+ P[4] := 3;\r
+ P[5] := 1;\r
+ FOR Q := 1 TO N DO\r
+ BEGIN\r
+ K := P[Q];\r
+ S := K;\r
+ FOR I := K + 1 TO Count DO\r
+ BEGIN\r
+ X := Item[I] ;\r
+ J := I - K;\r
+ IF S = 0;\r
+ BEGIN\r
+ S := K;\r
+ S := S + 1;\r
+ Item[S] := X;\r
+ END;\r
+ WHILE ( X < Item[J] ) and ( J > O ) and ( J <= Count ) DO\r
+ BEGIN\r
+ Item[J+K]:=Item[J];\r
+ J := J - K;\r
+ END;\r
+ Item[J+K] := X;\r
+ END;\r
+ END;\r
+ END;\r
--- /dev/null
+ {for i := 1 to veces do\r
+ begin\r
+\r
+ writeln( ar, 'ciclo for i := 1 to veces do. i: ', i );\r
+ }\r
+\r
+\r
+ {if veces1 = 1 then\r
+ begin\r
+ ape := ap + letra1 + GetRNDApellido( 5, 2 );\r
+ dni := dni + random( 50000 ) + 1;\r
+ writeln( ar, ap );\r
+ writeln( ar, dni );\r
+ writeln( ar );\r
+ writeln( 'En ape(completo): ', ape,' ', dni );\r
+ delay( 500 );\r
+ end\r
+ else\r
+ begin}\r
+\r
+ {if veces1 = 1 then\r
+ begin\r
+ ape := ap + letra1 + GetRNDApellido( 5, 2 );\r
+ dni := dni + random( 50000 ) + 1;\r
+ writeln( ar, ap );\r
+ writeln( ar, dni );\r
+ writeln( ar );\r
+ writeln( 'En ape(completo): ', ape,' ', dni );\r
+ delay( 500 );\r
+ end\r
+ else\r
+ begin}\r
+\r
+\r
+ if cant = 1000 then begin\r
+ char1 := 38;\r
+ mil := true;\r
+ end\r
+ else char1 := 34;\r
+ char2 := char1 + 1;\r
--- /dev/null
+#include <iostream.h>\r
+#include <stdlib.h>\r
+#include <time.h>\r
+\r
+int main( void )\r
+{\r
+ srandom( time(0) );\r
+\r
+ cout << random() << "\t" << time(0) << endl;\r
+}\r
--- /dev/null
+program rndnames;\r
+\r
+uses CRT, DOS;\r
+\r
+type\r
+ HORA = record\r
+ h,\r
+ m,\r
+ s,\r
+ c: longint;\r
+ end;\r
+\r
+ function GetTiempo( h1, h2: HORA ): longint;\r
+\r
+ var\r
+ t: longint;\r
+ aux: HORA;\r
+\r
+ begin\r
+ if h1.h <> h2.h then { pone al menor como h2 y al mayor como h1 }\r
+ begin\r
+ if h1.h < h2.h then\r
+ begin\r
+ aux := h1;\r
+ h1 := h2;\r
+ h2 := aux;\r
+ end\r
+ end\r
+ else if h1.m <> h2.m then\r
+ begin\r
+ if h1.m < h2.m then\r
+ begin\r
+ aux := h1;\r
+ h1 := h2;\r
+ h2 := aux;\r
+ end\r
+ end\r
+ else if h1.s <> h2.s then\r
+ begin\r
+ if h1.s < h2.s then\r
+ begin\r
+ aux := h1;\r
+ h1 := h2;\r
+ h2 := aux;\r
+ end\r
+ end\r
+ else if h1.c <> h2.c then\r
+ if h1.c < h2.c then\r
+ begin\r
+ aux := h1;\r
+ h1 := h2;\r
+ h2 := aux;\r
+ end;\r
+ t := ( ( ( h1.h - h2.h ) * 60 + ( h1.m - h2.m ) ) * 60 + ( h1.s - h2.s ) ) * 100 + ( h1.c - h2.c );\r
+ GetTiempo := t;\r
+ end; { function GetTiempo }\r
+\r
+\r
+ function GetRNDLetra( min, max: char ): char;\r
+ var i: longint;\r
+ begin\r
+ i := ord( max ) - ord( min ) + 1;\r
+ writeln( 'i: ', i );\r
+ GetRNDLetra := chr( random( i ) + ord( min ) );\r
+ end;\r
+\r
+\r
+var\r
+ cad: string;\r
+ i: integer;\r
+ h1, h2: HORA;\r
+ t: longint;\r
+\r
+begin\r
+ randomize;\r
+\r
+ h1.h := 10; h1.m := 10; h1.s := 10; h1.c := 10;\r
+ h2.h := 10; h2.m := 10; h2.s := 9; h2.c := 13;\r
+ t := GetTiempo( h2, h1 );\r
+ writeln( 'T: ', t );\r
+ writeln( 'Numero: ', random( 10 ) );\r
+ writeln( GetRNDLetra( 'A', 'Z' ) );\r
+ for i := 1 to 5 do\r
+ begin\r
+ cad[i] := 'A';\r
+ cad[0] := chr(i);\r
+ writeln( cad );\r
+ end;\r
+ if 'LUCA' > 'LUCALAMIDAS' then\r
+ writeln( '''LUCA'' > ''LUCALAMIDAS''' )\r
+ else\r
+ writeln( '''LUCA'' < ''LUCALAMIDAS''' );\r
+ writeln ('FIN');\r
+end.\r
--- /dev/null
+program RNDNames;\r
+\r
+const\r
+ MAX_APE = 30;\r
+\r
+type\r
+ TIPO_LETRA = ( TL_VOCAL, TL_CONSO );\r
+ TIPO_VOCAL = ( TV_AEIOU, TV_EI );\r
+ INDICADOR = ( I_NADA, I_ESB, I_ESC, I_ESF, I_ESG, I_ESL, I_ESM, I_ESN, I_ESQ, I_ESQU, I_ESR, I_EST );\r
+ APELLIDO = string[MAX_APE];\r
+\r
+(*********************************************************)\r
+\r
+ function GetVocal( tipo: TIPO_VOCAL ): char;\r
+\r
+ var\r
+ valor: integer;\r
+\r
+ begin\r
+ if tipo = TV_AEIOU then valor := random( 16 )\r
+ else valor := random( 6 ) + 5;\r
+ case valor of\r
+ 0..4: GetVocal := 'A';\r
+ 5..7: GetVocal :+ 'E';\r
+ 8..10: GetVocal :+ 'I';\r
+ 11..13: GetVocal :+ 'O';\r
+ 14..15: GetVocal :+ 'U';\r
+ end;\r
+ end;\r
+\r
+(*********************************************************)\r
+\r
+ procedure GetRNDConsonante( var indic: INDICADOR; var proxl: TIPO_LETRA; var conso: char );\r
+\r
+ var\r
+ valor: integer;\r
+\r
+ begin\r
+ proxl := TL_VOCAL;\r
+ indic := I_NADA;\r
+\r
+ case indic of\r
+ I_ESF, I_ESR, I_ESG, I_EST: conso := 'R';\r
+ I_ESB: case random( 2 ) of\r
+ 0: conso := 'R';\r
+ 1: conso := 'L';\r
+ end;\r
+ I_ESC: case random( 4 ) of\r
+ 0: conso := 'C';\r
+ 1: conso := 'H';\r
+ 2: conso := 'R';\r
+ 3: conso := 'L';\r
+ end;\r
+ I_ESL: case random( 6 ) of\r
+ 0: conso := 'T';\r
+ 1..5: conso := 'L';\r
+ end;\r
+ I_ESM: case random( 3 ) of\r
+ 0: conso := 'P';\r
+ 1: conso := 'B';\r
+ 2: conso := 'L';\r
+ end;\r
+ I_ESN: case random( 3 ) of\r
+ 0: conso := 'R';\r
+ 1: conso := 'V';\r
+ 2: conso := 'C';\r
+ end;\r
+ else case random( 55 ) of\r
+ 0..3: begin\r
+ conso := 'B';\r
+ if random( 20 ) = 0 then begin\r
+ indic := I_ESB;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 4..7: begin\r
+ conso := 'C';\r
+ if random( 15 ) = 0 then begin\r
+ indic := I_ESC;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 8..11: conso := 'D';\r
+ 12..14: begin\r
+ conso := 'F';\r
+ if random( 20 ) = 0 then begin\r
+ indic := I_ESF;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 15..17: begin\r
+ conso := 'G';\r
+ if random( 15 ) = 0 then\r
+ begin\r
+ indic := I_ESG;\r
+ if random( 4 ) = 0 then proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 18..19: conso := 'H';\r
+ 20..22: conso := 'J';\r
+ 23..24: conso := 'K';\r
+ 25..27: begin\r
+ conso := 'L';\r
+ if random( 35 ) = 0 then\r
+ begin\r
+ indic := I_ESL;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 28..30: begin\r
+ conso := 'M';\r
+ if random( 15 ) = 0 then\r
+ begin\r
+ indic := I_ESM;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 31..33: begin\r
+ conso := 'N';\r
+ if random( 15 ) = 0 then\r
+ begin\r
+ indic := I_ESN;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 34..36: conso := 'P';\r
+ 37..38: begin\r
+ conso := 'Q';\r
+ indic := I_ESQ;\r
+ end;\r
+ 39..41: begin\r
+ conso := 'R';\r
+ if random( 10 ) = 0 then\r
+ begin\r
+ indic := I_ESR;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 42..44: conso := 'S';\r
+ 45..47: begin\r
+ conso := 'T';\r
+ if random( 20 ) = 0 then\r
+ begin\r
+ indic := I_EST;\r
+ proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ 48..50: conso := 'V';\r
+ 51: conso := 'W';\r
+ 52: conso := 'X';\r
+ 53: conso := 'Y';\r
+ 54: conso := 'Z';\r
+ end;\r
+ end;\r
+ end; { case indic of }\r
+ end;\r
+\r
+(*********************************************************)\r
+\r
+ procedure GetRNDVocal( var indic: INDICADOR; var proxl: TIPO_LETRA; var vocal: char );\r
+\r
+ var\r
+ valor: integer;\r
+\r
+ begin\r
+ case proxl of\r
+ I_ESQ:\r
+ begin\r
+ vocal := 'U';\r
+ indic := I_ESQU;\r
+ proxl := TL_VOCAL;\r
+ end;\r
+ I_ESQU:\r
+ begin\r
+ vocal := GetVocal( TV_EI );\r
+ indic := I_NADA;\r
+ if random( 25 ) = 0 then proxl := TL_VOCAL\r
+ else proxl := TL_CONSO;\r
+ end;\r
+ else\r
+ begin\r
+ vocal := GetVocal( TV_AEIOU );\r
+ indic := I_NADA;\r
+ if random( 40 ) = 0 then proxl := TL_VOCAL\r
+ else proxl := TL_CONSO;\r
+ end;\r
+ end;\r
+ end;\r
+\r
+(*********************************************************)\r
+\r
+ function GetRNDApellido( max, min: integer ): APELLIDO;\r
+\r
+ var\r
+ tam, i: integer;\r
+ aux: char;\r
+ apellido: APELLIDO;\r
+ indic: INDICADOR;\r
+ proxl: TIPO_LETRA;\r
+\r
+ begin\r
+ if max > MAX_APE then max := MAX_APE;\r
+ tam := random( max + 1 ) + min;\r
+ indic := I_NADA;\r
+ apellido := '';\r
+ if random( 5 ) = 0 then proxl := TL_VOCAL\r
+ else proxl := TL_CONSO;\r
+ for i := 1 to tam do\r
+ begin\r
+ if proxl = TL_CONSO then GetRNDConsonante( indic, proxl, aux )\r
+ else GetRNDVocal( indic, proxl, aux );\r
+ apellido := apellido + aux;\r
+ end;\r
+ GetRNDApellido := apellido;\r
+ end;\r
+\r
+var\r
+ n, i: integer;\r
+\r
+begin\r
+ randomize; (* inicializa la semilla del random *)\r
+\r
+ write( 'Ingrese la cantidad de apellidos a generar: ' );\r
+ readln( n );\r
+ for i := 1 to n do\r
+ writeln( GetRNDApellido( 30, 4 ) );\r
+ writeln;\r
+ writeln( ' FIN!!!' );\r
+end;\r
projects / z.facultad / 75.40 / 1er-cuat / orden.git / commitdiff