From 41295f9e0972a2c89165fb6fbe737bbe56672be3 Mon Sep 17 00:00:00 2001 From: Leandro Lucarella Date: Thu, 27 May 2004 04:12:00 +0000 Subject: [PATCH] =?utf8?q?Se=20pone=20fin=20de=20l=C3=ADnea=20del=20sistem?= =?utf8?q?a.?= MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit --- informes/9C-C-INFORME.TXT | 106 +- informes/9C-D-INFORME.TXT | 106 +- informes/9D-C-INFORME.TXT | 106 +- informes/9D-D-INFORME.TXT | 106 +- informes/C-C-INFORME.TXT | 106 +- informes/C-D-INFORME.TXT | 106 +- informes/D-C-INFORME.TXT | 106 +- informes/D-D-INFORME.TXT | 106 +- informes/R-C-INFORME.TXT | 108 +- informes/R-D-INFORME.TXT | 108 +- src/comp-dbg.pas | 3322 ++++++++++++++++++------------------ src/comp.pas | 3332 ++++++++++++++++++------------------- test/IRDnames.pas | 636 +++---- test/ORDnames.pas | 662 ++++---- test/RNDnames.pas | 488 +++--- test/SORTINGMetodos.pas | 868 +++++----- test/cargar.pas | 488 +++--- test/comp_.pas | 2002 +++++++++++----------- test/msdemo.pas | 480 +++--- test/qsdemo.pas | 374 ++--- test/qsort.pas | 112 +- test/shellsort.pas | 78 +- test/temp.pas | 80 +- test/testrnd.cpp | 20 +- test/testrnd.pas | 188 +-- test/tsrndnms.pas | 458 ++--- 26 files changed, 7326 insertions(+), 7326 deletions(-) diff --git a/informes/9C-C-INFORME.TXT b/informes/9C-C-INFORME.TXT index b675d1e..9c1278b 100644 --- a/informes/9C-C-INFORME.TXT +++ b/informes/9C-C-INFORME.TXT @@ -1,54 +1,54 @@ - -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 + +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 diff --git a/informes/9C-D-INFORME.TXT b/informes/9C-D-INFORME.TXT index 7fb7dea..75e72c3 100644 --- a/informes/9C-D-INFORME.TXT +++ b/informes/9C-D-INFORME.TXT @@ -1,54 +1,54 @@ - -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 + +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 diff --git a/informes/9D-C-INFORME.TXT b/informes/9D-C-INFORME.TXT index fa4dde8..3d01f8b 100644 --- a/informes/9D-C-INFORME.TXT +++ b/informes/9D-C-INFORME.TXT @@ -1,54 +1,54 @@ - -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 + +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 diff --git a/informes/9D-D-INFORME.TXT b/informes/9D-D-INFORME.TXT index 4190391..d1afac0 100644 --- a/informes/9D-D-INFORME.TXT +++ b/informes/9D-D-INFORME.TXT @@ -1,54 +1,54 @@ - -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 + +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 diff --git a/informes/C-C-INFORME.TXT b/informes/C-C-INFORME.TXT index e71727d..8a205bf 100644 --- a/informes/C-C-INFORME.TXT +++ b/informes/C-C-INFORME.TXT @@ -1,54 +1,54 @@ - -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 + +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 diff --git a/informes/C-D-INFORME.TXT b/informes/C-D-INFORME.TXT index c395033..2df95b4 100644 --- a/informes/C-D-INFORME.TXT +++ b/informes/C-D-INFORME.TXT @@ -1,54 +1,54 @@ - -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 + +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 diff --git a/informes/D-C-INFORME.TXT b/informes/D-C-INFORME.TXT index d83fe91..c4b02e6 100644 --- a/informes/D-C-INFORME.TXT +++ b/informes/D-C-INFORME.TXT @@ -1,54 +1,54 @@ - -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 + +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 diff --git a/informes/D-D-INFORME.TXT b/informes/D-D-INFORME.TXT index a5b2ecb..d0c6dda 100644 --- a/informes/D-D-INFORME.TXT +++ b/informes/D-D-INFORME.TXT @@ -1,54 +1,54 @@ - -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 + +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 diff --git a/informes/R-C-INFORME.TXT b/informes/R-C-INFORME.TXT index 5926d65..53b6893 100644 --- a/informes/R-C-INFORME.TXT +++ b/informes/R-C-INFORME.TXT @@ -1,54 +1,54 @@ - -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. + +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. diff --git a/informes/R-D-INFORME.TXT b/informes/R-D-INFORME.TXT index 48ce920..2aacad5 100644 --- a/informes/R-D-INFORME.TXT +++ b/informes/R-D-INFORME.TXT @@ -1,54 +1,54 @@ - -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. + +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. diff --git a/src/comp-dbg.pas b/src/comp-dbg.pas index 383cfc9..faaf2f8 100644 --- a/src/comp-dbg.pas +++ b/src/comp-dbg.pas @@ -1,1662 +1,1662 @@ -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; +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 diff --git a/src/comp.pas b/src/comp.pas index e69bd46..887e92d 100644 --- a/src/comp.pas +++ b/src/comp.pas @@ -1,1667 +1,1667 @@ -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; +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 diff --git a/test/IRDnames.pas b/test/IRDnames.pas index 9edf442..2d25998 100644 --- a/test/IRDnames.pas +++ b/test/IRDnames.pas @@ -1,319 +1,319 @@ -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 ); +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 diff --git a/test/ORDnames.pas b/test/ORDnames.pas index 945994a..77b7641 100644 --- a/test/ORDnames.pas +++ b/test/ORDnames.pas @@ -1,332 +1,332 @@ -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 ); +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 diff --git a/test/RNDnames.pas b/test/RNDnames.pas index f6d9f8b..27bbecf 100644 --- a/test/RNDnames.pas +++ b/test/RNDnames.pas @@ -1,244 +1,244 @@ -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 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. diff --git a/test/SORTINGMetodos.pas b/test/SORTINGMetodos.pas index 4b334c0..7c9d5fb 100644 --- a/test/SORTINGMetodos.pas +++ b/test/SORTINGMetodos.pas @@ -1,435 +1,435 @@ -{ 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 +{ 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 diff --git a/test/cargar.pas b/test/cargar.pas index f6d9f8b..27bbecf 100644 --- a/test/cargar.pas +++ b/test/cargar.pas @@ -1,244 +1,244 @@ -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 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. diff --git a/test/comp_.pas b/test/comp_.pas index 91def5d..72bc679 100644 --- a/test/comp_.pas +++ b/test/comp_.pas @@ -1,1002 +1,1002 @@ -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 );} +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 diff --git a/test/msdemo.pas b/test/msdemo.pas index aa9abc8..477b68a 100644 --- a/test/msdemo.pas +++ b/test/msdemo.pas @@ -1,240 +1,240 @@ -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 ); +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. + diff --git a/test/qsdemo.pas b/test/qsdemo.pas index f33b5c3..aeee128 100644 --- a/test/qsdemo.pas +++ b/test/qsdemo.pas @@ -1,187 +1,187 @@ -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 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. + diff --git a/test/qsort.pas b/test/qsort.pas index 759aaf3..3f9a621 100644 --- a/test/qsort.pas +++ b/test/qsort.pas @@ -1,57 +1,57 @@ -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); +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 diff --git a/test/shellsort.pas b/test/shellsort.pas index 656d8d5..f7086e8 100644 --- a/test/shellsort.pas +++ b/test/shellsort.pas @@ -1,39 +1,39 @@ -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; +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; diff --git a/test/temp.pas b/test/temp.pas index 1dffd19..d94af89 100644 --- a/test/temp.pas +++ b/test/temp.pas @@ -1,40 +1,40 @@ - {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; + {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; diff --git a/test/testrnd.cpp b/test/testrnd.cpp index e8d77ac..df24245 100644 --- a/test/testrnd.cpp +++ b/test/testrnd.cpp @@ -1,10 +1,10 @@ -#include -#include -#include - -int main( void ) -{ - srandom( time(0) ); - - cout << random() << "\t" << time(0) << endl; -} +#include +#include +#include + +int main( void ) +{ + srandom( time(0) ); + + cout << random() << "\t" << time(0) << endl; +} diff --git a/test/testrnd.pas b/test/testrnd.pas index 0a438e2..97559f2 100644 --- a/test/testrnd.pas +++ b/test/testrnd.pas @@ -1,94 +1,94 @@ -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; + +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. diff --git a/test/tsrndnms.pas b/test/tsrndnms.pas index 8bc3d9b..dae1c47 100644 --- a/test/tsrndnms.pas +++ b/test/tsrndnms.pas @@ -1,229 +1,229 @@ -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; +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; -- 2.43.0