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