]> git.llucax.com Git - z.facultad/75.06/emufs.git/blob - emufs/external_sort/comp.pas
External sort casi listo, falta debuggear un poco e integrarlo al EMUFS.
[z.facultad/75.06/emufs.git] / emufs / external_sort / comp.pas
1 program Comparacion_De_Algoritmos_De_Ordenamiento;
2
3 uses
4     CRT, DOS;
5
6 const
7      MAX_APE = 15;
8      RETARDO = 50;
9      VERSION = '1.2.8';
10
11 type
12     APELLIDO = string[MAX_APE];
13     DOCUMENTO = longint;
14     PERSONA = record
15                     ap: APELLIDO;
16                     dni: DOCUMENTO;
17               end;
18     TABLA = array[1..1000] of PERSONA;
19
20 (*********************************************************)
21
22  procedure CargarArchivo( var datos: TABLA; var ar: text; tam: integer );
23
24     var
25        i: integer;
26
27     begin
28          for i:= 1 to tam do
29             begin
30                  writeln( ar, datos[i].ap );
31                  writeln( ar, datos[i].dni );
32                  writeln( ar );
33             end;
34     end; { procedure CargarArchivo }
35
36 (*********************************************************)
37
38  procedure Retardar( centenas: longint );
39
40     var
41        i: integer;
42
43     begin
44          for i:= 1 to centenas * 100 do ;
45     end; { procedure Retardar }
46
47 (*********************************************************)
48 (*********************************************************)
49
50  procedure MenuEvaluar( var datos: TABLA; var arch: text );
51
52     type
53         HORA = record
54                      h,
55                      m,
56                      s,
57                      c: longint;
58                end;
59         ORDEN = ( CRECIENTE, DECRECIENTE );
60         MEDICION = record
61                          Comp,
62                          Int,
63                          Tiem: longint;
64                    end;
65     var
66        bs, bsm, shs, rs, ss, is, sls, slsm, qs: MEDICION;
67
68     (*********************************************************)
69
70     procedure CrearInforme( ord: ORDEN );
71
72        (*********************************************************)
73
74        procedure InfMetodo( var info: text; metodo: string; sort: MEDICION );
75
76           begin
77                writeln( info );
78                writeln( info, metodo, ':' );
79                writeln( info, '             Comparaciones: ', sort.Comp: 1 );
80                writeln( info, '             Intercambios:  ', sort.Int div 3: 1, ' (', sort.Int: 1, ' asignaciones)' );
81                writeln( info, '             Tiempo (seg):  ', sort.Tiem / 100: 2: 2 );
82           end; { procedure InfMetodo }
83
84        (*********************************************************)
85
86        var { procedure CrearInforme }
87           info: text;
88
89        begin
90             assign( info, 'INFORME.TXT' );
91             rewrite( info );
92             writeln( info );
93             if ord = DECRECIENTE then
94               begin
95                    writeln( info, 'INFORME: Orden Decreciente.' );
96                    writeln( info, '=======  ~~~~~ ~~~~~~~~~~~' );
97               end
98             else
99               begin
100                    writeln( info, 'INFORME: Orden Creciente.' );
101                    writeln( info, '=======  ~~~~~ ~~~~~~~~~' );
102               end;
103             writeln( info );
104             InfMetodo( info, 'Bubble Sort', bs );
105             InfMetodo( info, 'Bubble Sort Mejorado', bsm );
106             InfMetodo( info, 'Shake Sort', shs );
107             InfMetodo( info, 'Ripple Sort', rs );
108             InfMetodo( info, 'Selection Sort', ss );
109             InfMetodo( info, 'Insertion Sort', is );
110             InfMetodo( info, 'Shell''s Sort', sls );
111             InfMetodo( info, 'Shell''s Sort Mejorado', slsm );
112             InfMetodo( info, 'Quick Sort', qs );
113             writeln( info );
114             writeln( info );
115             writeln( info, 'NOTA: La cantidad de intercambios medida se tom¢ a partir de la cantidad de' );
116             writeln( info, '====  asignaciones, ya que en el Insertion Sort no hay intercambios. De esta' );
117             writeln( info, '      manera, un intercambio equivales a 3 asignaciones.' );
118             close( info );
119        end; { procedure CrearInforme }
120
121     (*********************************************************)
122
123     procedure NoExisteArch;
124
125        begin
126             clrscr;
127             gotoxy( 20, 10 );
128             textcolor( LightMagenta + Blink );
129             writeln( 'ERROR: No existe el archivo a evaluar!' );
130             textcolor( LightGray );
131             writeln;
132             writeln( '             Creelo seleccionando la opci¢n 1 del Men£ Principal.' );
133             delay( 4000 );
134        end; { procedure NoExisteArch }
135
136     (*********************************************************)
137
138     function ExisteArchivo( nombre: String ): boolean;
139
140     { funcion extrida de la ayuda del Turbo Pascal 7 }
141
142        var
143           arch: text;
144
145        begin
146             {$I-}
147             Assign( arch, nombre );
148             FileMode := 0;  { Solo lectura }
149             Reset( arch );
150             Close( arch );
151             {$I+}
152             ExisteArchivo := (IOResult = 0) and (nombre <> '');
153        end; { function ExisteArchivo }
154
155     (*********************************************************)
156
157        procedure CargarTabla( var ar: text; var datos: TABLA; tam: integer );
158
159           var
160              i: integer;
161              void: string[2];
162
163           begin
164                for i:= 1 to tam do
165                   begin
166                        readln( ar, datos[i].ap );
167                        readln( ar, datos[i].dni );
168                        readln( ar, void );
169                   end;
170           end; { procedure CargarTabla }
171
172     (*********************************************************)
173
174     procedure Intercambiar( var a, b: PERSONA; var int: longint );
175
176        var
177           aux: PERSONA;
178
179        begin
180             int := int + 1;
181             Retardar( RETARDO );
182             aux := a;
183             int := int + 1;
184             Retardar( RETARDO );
185             a := b;
186             int := int + 1;
187             Retardar( RETARDO );
188             b := aux;
189        end; { procedure Intercambiar }
190
191     (*********************************************************)
192
193     procedure GetHora( var hor: HORA );
194
195        var
196           h, m, s, c: word;
197
198        begin
199             gettime( h, m, s, c );
200             hor.h := h;
201             hor.m := m;
202             hor.s := s;
203             hor.c := c;
204        end; { procedure GetHora }
205
206     (*********************************************************)
207
208     function GetTiempo( h1, h2: HORA ): longint;
209
210        var
211           t: longint;
212           aux: HORA;
213
214        begin
215             if h1.h <> h2.h then { pone al menor como h2 y al mayor como h1 }
216               begin
217               if h1.h < h2.h then
218                 begin
219                      aux := h1;
220                      h1 := h2;
221                      h2 := aux;
222                 end
223               end
224             else if h1.m <> h2.m then
225                    begin
226                    if h1.m < h2.m then
227                      begin
228                           aux := h1;
229                           h1 := h2;
230                           h2 := aux;
231                      end
232                    end
233                  else if h1.s <> h2.s then
234                         begin
235                         if h1.s < h2.s then
236                           begin
237                                aux := h1;
238                                h1 := h2;
239                                h2 := aux;
240                           end
241                         end
242                       else if h1.c <> h2.c then
243                              if h1.c < h2.c then
244                                begin
245                                     aux := h1;
246                                     h1 := h2;
247                                     h2 := aux;
248                                end;
249             t := ( ( ( h1.h - h2.h ) * 60 + ( h1.m - h2.m ) ) * 60  + ( h1.s - h2.s ) ) * 100 + ( h1.c - h2.c );
250             GetTiempo := t;
251        end; { function GetTiempo }
252
253     (*********************************************************)
254
255     procedure EvaluarCre( var datos: TABLA; var arch: text );
256
257        (*********************************************************)
258
259        procedure BubbleSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION );
260
261           var
262              i, j: integer;
263              h1, h2: HORA;
264
265           begin
266                GetHora( h1 );
267                m.Comp := 0;
268                m.Int := 0;
269                reset( arch );
270                CargarTabla( arch, datos, 1000 );
271                close( arch );
272                for i := tam - 1 downto 1 do
273                begin
274                     for j := tam - 1 downto 1 do
275                       begin
276                            m.Comp := m.Comp + 1;
277                            Retardar( RETARDO );
278                            if datos[j].ap > datos[j+1].ap then
279                              Intercambiar( datos[j], datos[j+1], m.Int);
280                       end;
281                end;
282              GetHora( h2 );
283              m.Tiem := GetTiempo( h1, h2 );
284         end; { procedure BubbleSort }
285
286        (*********************************************************)
287
288        procedure BubbleSortMej( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION );
289
290           var
291              huboint: boolean;
292              i, n: integer;
293              h1, h2: HORA;
294
295           begin
296                GetHora( h1 );
297                m.Comp := 0;
298                m.Int := 0;
299                n := 1;
300                reset( arch );
301                CargarTabla( arch, datos, 1000 );
302                close( arch );
303                huboint := true;
304                while huboint do
305                  begin
306                       huboint := false;
307                       for i := tam - 1 downto n do
308                         begin
309                              m.Comp := m.Comp + 1;
310                              Retardar( RETARDO );
311                              if datos[i].ap > datos[i+1].ap then
312                                begin
313                                     Intercambiar( datos[i], datos[i+1], m.Int);
314                                     huboint := true;
315                                end;
316                         end;
317                       n := n + 1;
318                  end;
319                GetHora( h2 );
320                m.Tiem := GetTiempo( h1, h2 );
321           end; { procedure BubbleSortMej }
322
323        (*********************************************************)
324
325        procedure ShakeSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION );
326           var
327              h1, h2: HORA;
328              i, d, j, tmp: integer;
329
330           begin
331                GetHora( h1 );
332                m.Comp := 0;
333                m.Int := 0;
334                reset( arch );
335                CargarTabla( arch, datos, 1000 );
336                close( arch );
337                i := 2;
338                d := tam;
339                tmp := tam;
340                repeat
341                      for j := d downto i do
342                       begin
343                        m.Comp := m.Comp + 1;
344                        Retardar( RETARDO );
345                        if datos[j].ap < datos[j-1].ap then
346                          begin
347                               Intercambiar( datos[j], datos[j-1], m.Int );
348                               tmp := j;
349                          end;
350                       end;
351                      i := tmp + 1;
352                      for j := i to d do
353                       begin
354                        m.Comp := m.Comp + 1;
355                        Retardar( RETARDO );
356                        if datos[j].ap < datos[j-1].ap then
357                          begin
358                               Intercambiar( datos[j], datos[j-1], m.Int );
359                               tmp := j;
360                          end;
361                       end;
362                      d := tmp - 1;
363                until i >= d;
364                GetHora( h2 );
365                m.Tiem := GetTiempo( h1, h2 );
366           end; { procedure ShakeSort }
367
368        (*********************************************************)
369
370        procedure RippleSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION );
371           var
372              h1, h2: HORA;
373              i, j: integer;
374
375           begin
376                GetHora( h1 );
377                m.Comp := 0;
378                m.Int := 0;
379                reset( arch );
380                CargarTabla( arch, datos, 1000 );
381                close( arch );
382                for i := 1 to tam do
383                  begin
384                       for j := i + 1 to tam do
385                         begin
386                              m.Comp := m.Comp + 1;
387                              Retardar( RETARDO );
388                              if datos[i].ap > datos[j].ap then Intercambiar( datos[i], datos[j], m.Int );
389                         end;
390                  end;
391                GetHora( h2 );
392                m.Tiem := GetTiempo( h1, h2 );
393           end; { procedure RippleSort }
394
395        (*********************************************************)
396
397        procedure SelectionSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION );
398           var
399              i, sel, n: integer;
400              hubosel: boolean;
401              h1, h2: HORA;
402
403           begin
404                GetHora( h1 );
405                m.Comp := 0;
406                m.Int := 0;
407                reset( arch );
408                CargarTabla( arch, datos, 1000 );
409                close( arch );
410                for n := 1 to tam - 1 do
411                  begin
412                       hubosel := false;
413                       sel := n;
414                       for i := n + 1 to tam do
415                         begin
416                              m.Comp := m.Comp + 1;
417                              Retardar( RETARDO );
418                              if datos[sel].ap > datos[i].ap then
419                                begin
420                                     sel := i;
421                                     hubosel := true;
422                                end;
423                         end;
424                       if hubosel then Intercambiar( datos[n], datos[sel], m.Int);
425                  end;
426                GetHora( h2 );
427                m.Tiem := GetTiempo( h1, h2 );
428           end; { procedure SelectionSort }
429
430        (*********************************************************)
431
432        procedure InsertionSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION );
433           var
434              h1, h2: HORA;
435              i, j, k: integer;
436              tmp: PERSONA;
437              terminar: boolean;
438
439           begin
440                GetHora( h1 );
441                m.Comp := 0;
442                m.Int := 0;
443                reset( arch );
444                CargarTabla( arch, datos, 1000 );
445                close( arch );
446                for i := 2 to tam do
447                  begin
448                       m.Int := m.Int + 1;
449                       Retardar( RETARDO );
450                       tmp := datos[i];
451                       j := i - 1;
452                       terminar := false;
453                       while ( j >= 1 ) and ( not terminar ) do
454                         begin
455                              m.Comp := m.Comp + 1;
456                              Retardar( RETARDO );
457                              if ( tmp.ap < datos[j].ap ) then
458                                begin
459                                     m.Int := m.Int + 1;
460                                     Retardar( RETARDO );
461                                     datos[j+1] := datos[j];
462                                     j := j - 1;
463                                end
464                              else terminar := true;
465                         end;
466                       m.Int := m.Int + 1;
467                       Retardar( RETARDO );
468                       datos[j+1] := tmp;
469                  end;
470                GetHora( h2 );
471                m.Tiem := GetTiempo( h1, h2 );
472           end; { procedure InsertionSort }
473
474        (*********************************************************)
475
476        procedure ShellSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION );
477           var
478              h1, h2: HORA;
479              hueco, i, j: integer;
480              huboint: boolean;
481
482           begin
483                GetHora( h1 );
484                m.Comp := 0;
485                m.Int := 0;
486                reset( arch );
487                CargarTabla( arch, datos, 1000 );
488                close( arch );
489                hueco := tam;
490                while hueco > 1 do
491                  begin
492                       hueco := hueco div 2;
493                       huboint := true;
494                       while huboint do
495                         begin
496                              huboint := false;
497                              for i := 1 to tam - hueco do
498                                begin
499                                     j := i + hueco;
500                                     m.Comp := m.Comp + 1;
501                                     Retardar( RETARDO );
502                                     if ( datos[i].ap > datos[j].ap ) then
503                                       begin
504                                            Intercambiar( datos[i], datos[j], m.Int );
505                                            huboint := true;
506                                       end;
507                                end;
508                         end;
509                  end;
510                GetHora( h2 );
511                m.Tiem := GetTiempo( h1, h2 );
512           end; { procedure ShellSort }
513
514        (*********************************************************)
515
516        procedure ShellSortMej( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION );
517
518           (*********************************************************)
519
520           procedure Shell( var datos: TABLA; hueco, i: integer; var comp, int: longint );
521              var
522                 j: integer;
523
524              begin
525                   j := i + hueco;
526                   comp := comp + 1;
527                   Retardar( RETARDO );
528                   if ( datos[i].ap > datos[j].ap ) then
529                     begin
530                          Intercambiar( datos[i], datos[j], int );
531                          if (i - hueco) > 0 then
532                            Shell( datos, hueco, i - hueco, comp, int );
533                     end;
534              end; { procedure Shell }
535
536           (*********************************************************)
537
538           var { procedure ShellSortMej }
539              h1, h2: HORA;
540              hueco, i, j: integer;
541
542           begin
543                GetHora( h1 );
544                m.Comp := 0;
545                m.Int := 0;
546                reset( arch );
547                CargarTabla( arch, datos, 1000 );
548                close( arch );
549                hueco := tam;
550                while hueco > 1 do
551                  begin
552                       hueco := hueco div 2;
553                       for i := 1 to tam - hueco do
554                         begin
555                              j := i + hueco;
556                              m.Comp := m.Comp + 1;
557                              Retardar( RETARDO );
558                              if ( datos[i].ap > datos[j].ap ) then
559                                begin
560                                     Intercambiar( datos[i], datos[j], m.Int );
561                                     if (i - hueco) > 0 then
562                                       Shell( datos, hueco, i - hueco, m.Comp, m.Int );
563                                end;
564                         end;
565                  end;
566                GetHora( h2 );
567                m.Tiem := GetTiempo( h1, h2 );
568           end; { procedure ShellSortMej }
569
570        (*********************************************************)
571
572        procedure QuickSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION );
573
574           (*********************************************************)
575
576           procedure QSort( var datos: TABLA; min, max: integer; var comp, int: longint );
577
578              var
579                 i, j: integer;
580                 sel: PERSONA;
581                 flag: boolean;
582
583              begin
584                   sel := datos[( min + max ) div 2];
585                   i := min;
586                   j := max;
587                   repeat
588                         comp := comp + 1;
589                         Retardar( RETARDO );
590                         flag := false;
591                         while datos[i].ap < sel.ap do
592                           begin
593                                if flag then begin
594                                                  comp := comp + 1;
595                                                  Retardar( RETARDO );
596                                             end
597                                        else flag := true;
598                                i := i + 1;
599                           end;
600                         comp := comp + 1;
601                         Retardar( RETARDO );
602                         flag := false;
603                         while datos[j].ap > sel.ap do
604                           begin
605                                if flag then begin
606                                                  comp := comp + 1;
607                                                  Retardar( RETARDO );
608                                             end
609                                        else flag := true;
610                                j := j - 1;
611                           end;
612                         if i <= j then
613                           begin
614                                if i < j then Intercambiar( datos[i], datos[j], int );
615                                i := i + 1;
616                                j := j - 1;
617                           end;
618                   until i > j;
619                   if min < j then QSort( datos, min, j, comp, int);
620                   if i < max then QSort( datos, i, max, comp, int);
621              end; { procedure QSort }
622
623           (*********************************************************)
624
625           var
626              h1, h2: HORA;
627
628           begin { procedure QuickSort }
629                GetHora( h1 );
630                m.Comp := 0;
631                m.Int := 0;
632                reset( arch );
633                CargarTabla( arch, datos, 1000 );
634                close( arch );
635                QSort( datos, 1, 1000, m.Comp, m.Int );
636                GetHora( h2 );
637                m.Tiem := GetTiempo( h1, h2 );
638           end; { procedure QuickSort }
639
640        (*********************************************************)
641
642        begin { procedure EvaluarCre }
643             if ExisteArchivo( 'DATOS.TXT' ) then
644               begin
645                    BubbleSort( arch, datos, 1000, bs );
646                    BubbleSortMej( arch, datos, 1000, bsm );
647                    ShakeSort( arch, datos, 1000, shs );
648                    RippleSort( arch, datos, 1000, rs );
649                    SelectionSort( arch, datos, 1000, ss );
650                    InsertionSort( arch, datos, 1000, is );
651                    ShellSort( arch, datos, 1000, sls );
652                    ShellSortMej( arch, datos, 1000, slsm );
653                    QuickSort( arch, datos, 1000, qs );
654                    CrearInforme( CRECIENTE );
655              end
656             else
657             NoExisteArch;
658        end;  { procedure EvaluarCre }
659
660     (*********************************************************)
661
662     procedure EvaluarDec( var datos: TABLA; var arch: text );
663
664        (*********************************************************)
665
666        procedure BubbleSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION );
667
668           var
669              i, j: integer;
670              h1, h2: HORA;
671
672           begin
673                GetHora( h1 );
674                m.Comp := 0;
675                m.Int := 0;
676                reset( arch );
677                CargarTabla( arch, datos, 1000 );
678                close( arch );
679                for i := tam - 1 downto 1 do
680                begin
681                     for j := tam - 1 downto 1 do
682                       begin
683                            m.Comp := m.Comp + 1;
684                            Retardar( RETARDO );
685                            if datos[j].ap < datos[j+1].ap then
686                              Intercambiar( datos[j], datos[j+1], m.Int);
687                       end;
688                end;
689                GetHora( h2 );
690                m.Tiem := GetTiempo( h1, h2 );
691         end; { procedure BubbleSort }
692
693        (*********************************************************)
694
695        procedure BubbleSortMej( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION );
696
697           var
698              huboint: boolean;
699              i, n: integer;
700              h1, h2: HORA;
701
702           begin
703                GetHora( h1 );
704                m.Comp := 0;
705                m.Int := 0;
706                n := 1;
707                reset( arch );
708                CargarTabla( arch, datos, 1000 );
709                close( arch );
710                huboint := true;
711                while huboint do
712                  begin
713                       huboint := false;
714                       for i := tam - 1 downto n do
715                         begin
716                              m.Comp := m.Comp + 1;
717                              Retardar( RETARDO );
718                              if datos[i].ap < datos[i+1].ap then
719                                begin
720                                     Intercambiar( datos[i], datos[i+1], m.Int);
721                                     huboint := true;
722                                end;
723                         end;
724                       n := n + 1;
725                  end;
726                GetHora( h2 );
727                m.Tiem := GetTiempo( h1, h2 );
728           end; { procedure BubbleSortMej }
729
730        (*********************************************************)
731
732        procedure ShakeSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION );
733           var
734              h1, h2: HORA;
735              i, d, j, tmp: integer;
736
737           begin
738                GetHora( h1 );
739                m.Comp := 0;
740                m.Int := 0;
741                reset( arch );
742                CargarTabla( arch, datos, 1000 );
743                close( arch );
744                i := 2;
745                d := tam;
746                tmp := tam;
747                repeat
748                      for j := d downto i do
749                       begin
750                        m.Comp := m.Comp + 1;
751                        Retardar( RETARDO );
752                        if datos[j].ap > datos[j-1].ap then
753                          begin
754                               Intercambiar( datos[j], datos[j-1], m.Int );
755                               tmp := j;
756                          end;
757                       end;
758                      i := tmp + 1;
759                      for j := i to d do
760                       begin
761                        m.Comp := m.Comp + 1;
762                        Retardar( RETARDO );
763                        if datos[j].ap > datos[j-1].ap then
764                          begin
765                               Intercambiar( datos[j], datos[j-1], m.Int );
766                               tmp := j;
767                          end;
768                       end;
769                      d := tmp - 1;
770                until i >= d;
771                GetHora( h2 );
772                m.Tiem := GetTiempo( h1, h2 );
773           end; { procedure ShakeSort }
774
775        (*********************************************************)
776
777        procedure RippleSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION );
778           var
779              h1, h2: HORA;
780              i, j: integer;
781
782           begin
783                GetHora( h1 );
784                m.Comp := 0;
785                m.Int := 0;
786                reset( arch );
787                CargarTabla( arch, datos, 1000 );
788                close( arch );
789                for i := 1 to tam do
790                  begin
791                       for j := i + 1 to tam do
792                         begin
793                              m.Comp := m.Comp + 1;
794                              Retardar( RETARDO );
795                              if datos[i].ap < datos[j].ap then Intercambiar( datos[i], datos[j], m.Int );
796                         end;
797                  end;
798                GetHora( h2 );
799                m.Tiem := GetTiempo( h1, h2 );
800           end; { procedure RippleSort }
801
802        (*********************************************************)
803
804        procedure SelectionSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION );
805           var
806              i, sel, n: integer;
807              hubosel: boolean;
808              h1, h2: HORA;
809
810           begin
811                GetHora( h1 );
812                m.Comp := 0;
813                m.Int := 0;
814                reset( arch );
815                CargarTabla( arch, datos, 1000 );
816                close( arch );
817                for n := 1 to tam - 1 do
818                  begin
819                       hubosel := false;
820                       sel := n;
821                       for i := n + 1 to tam do
822                         begin
823                              m.Comp := m.Comp + 1;
824                              Retardar( RETARDO );
825                              if datos[sel].ap < datos[i].ap then
826                                begin
827                                     sel := i;
828                                     hubosel := true;
829                                end;
830                         end;
831                       if hubosel then Intercambiar( datos[n], datos[sel], m.Int);
832                  end;
833                GetHora( h2 );
834                m.Tiem := GetTiempo( h1, h2 );
835           end; { procedure SelectionSort }
836
837        (*********************************************************)
838
839        procedure InsertionSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION );
840           var
841              h1, h2: HORA;
842              i, j, k: integer;
843              tmp: PERSONA;
844              terminar: boolean;
845
846           begin
847                GetHora( h1 );
848                m.Comp := 0;
849                m.Int := 0;
850                reset( arch );
851                CargarTabla( arch, datos, 1000 );
852                close( arch );
853                for i := 2 to tam do
854                  begin
855                       m.Int := m.Int + 1;
856                       Retardar( RETARDO );
857                       tmp := datos[i];
858                       j := i - 1;
859                       terminar := false;
860                       while ( j >= 1 ) and ( not terminar ) do
861                         begin
862                              m.Comp := m.Comp + 1;
863                              Retardar( RETARDO );
864                              if ( tmp.ap > datos[j].ap ) then
865                                begin
866                                     m.Int := m.Int + 1;
867                                     Retardar( RETARDO );
868                                     datos[j+1] := datos[j];
869                                     j := j - 1;
870                                end
871                              else terminar := true;
872                         end;
873                       m.Int := m.Int + 1;
874                       Retardar( RETARDO );
875                       datos[j+1] := tmp;
876                  end;
877                GetHora( h2 );
878                m.Tiem := GetTiempo( h1, h2 );
879           end; { procedure InsertionSort }
880
881        (*********************************************************)
882
883        procedure ShellSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION );
884           var
885              h1, h2: HORA;
886              hueco, i, j: integer;
887              huboint: boolean;
888
889           begin
890                GetHora( h1 );
891                m.Comp := 0;
892                m.Int := 0;
893                reset( arch );
894                CargarTabla( arch, datos, 1000 );
895                close( arch );
896                hueco := tam;
897                while hueco > 1 do
898                  begin
899                       hueco := hueco div 2;
900                       huboint := true;
901                       while huboint do
902                         begin
903                              huboint := false;
904                              for i := 1 to tam - hueco do
905                                begin
906                                     j := i + hueco;
907                                     m.Comp := m.Comp + 1;
908                                     Retardar( RETARDO );
909                                     if ( datos[i].ap < datos[j].ap ) then
910                                       begin
911                                            Intercambiar( datos[i], datos[j], m.Int );
912                                            huboint := true;
913                                       end;
914                                end;
915                         end;
916                  end;
917                GetHora( h2 );
918                m.Tiem := GetTiempo( h1, h2 );
919           end; { procedure ShellSort }
920
921        (*********************************************************)
922
923        procedure ShellSortMej( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION );
924
925           (*********************************************************)
926
927           procedure Shell( var datos: TABLA; hueco, i: integer;
928                            var comp: longint; var int: longint );
929              var
930                 j: integer;
931
932              begin
933                   j := i + hueco;
934                   comp := comp + 1;
935                   Retardar( RETARDO );
936                   if ( datos[i].ap < datos[j].ap ) then
937                     begin
938                          Intercambiar( datos[i], datos[j], int );
939                          if (i - hueco) > 0 then
940                            Shell( datos, hueco, i - hueco, comp, int );
941                     end;
942              end; { procedure Shell }
943
944           (*********************************************************)
945
946           var { procedure ShellSortMej }
947              h1, h2: HORA;
948              hueco, i, j: integer;
949
950           begin
951                GetHora( h1 );
952                m.Comp := 0;
953                m.Int := 0;
954                reset( arch );
955                CargarTabla( arch, datos, 1000 );
956                close( arch );
957                hueco := tam;
958                while hueco > 1 do
959                  begin
960                       hueco := hueco div 2;
961                       for i := 1 to tam - hueco do
962                         begin
963                              j := i + hueco;
964                              m.Comp := m.Comp + 1;
965                              Retardar( RETARDO );
966                              if ( datos[i].ap < datos[j].ap ) then
967                                begin
968                                     Intercambiar( datos[i], datos[j], m.Int );
969                                     if (i - hueco) > 0 then
970                                       Shell( datos, hueco, i - hueco, m.Comp, m.Int );
971                                end;
972                         end;
973                  end;
974                GetHora( h2 );
975                m.Tiem := GetTiempo( h1, h2 );
976           end; { procedure ShellSortMej }
977
978        (*********************************************************)
979
980        procedure QuickSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION );
981
982           procedure QSort( var datos: TABLA; min, max: integer;
983                            var comp: longint; var int: longint );
984
985              var
986                 i, j: integer;
987                 sel: PERSONA;
988                 flag: boolean;
989
990              begin
991                   sel := datos[( min + max ) div 2];
992                   i := min;
993                   j := max;
994                   repeat
995                         comp := comp + 1;
996                         Retardar( RETARDO );
997                         flag := false;
998                         while datos[i].ap > sel.ap do
999                           begin
1000                                if flag then begin
1001                                                  comp := comp + 1;
1002                                                  Retardar( RETARDO );
1003                                             end
1004                                        else flag := true;
1005                                i := i + 1;
1006                           end;
1007                         comp := comp + 1;
1008                         Retardar( RETARDO );
1009                         flag := false;
1010                         while datos[j].ap < sel.ap do
1011                           begin
1012                                if flag then begin
1013                                                  comp := comp + 1;
1014                                                  Retardar( RETARDO );
1015                                             end
1016                                        else flag := true;
1017                                j := j - 1;
1018                           end;
1019                         if i <= j then
1020                           begin
1021                                if i < j then Intercambiar( datos[i], datos[j], int );
1022                                i := i + 1;
1023                                j := j - 1;
1024                           end;
1025                   until i > j;
1026                   if min < j then QSort( datos, min, j, comp, int);
1027                   if i < max then QSort( datos, i, max, comp, int);
1028              end; { procedure QSort }
1029
1030           (*********************************************************)
1031
1032           var
1033              h1, h2: HORA;
1034
1035           begin { procedure QuickSort }
1036                GetHora( h1 );
1037                m.Comp := 0;
1038                m.Int := 0;
1039                reset( arch );
1040                CargarTabla( arch, datos, 1000 );
1041                close( arch );
1042                QSort( datos, 1, 1000, m.Comp, m.Int );
1043                GetHora( h2 );
1044                m.Tiem := GetTiempo( h1, h2 );
1045           end; { procedure QuickSort }
1046
1047        (*********************************************************)
1048
1049        begin { procedure EvaluarDec }
1050             if ExisteArchivo( 'DATOS.TXT' ) then
1051               begin
1052                    BubbleSort( arch, datos, 1000, bs );
1053                    BubbleSortMej( arch, datos, 1000, bsm );
1054                    ShakeSort( arch, datos, 1000, shs );
1055                    RippleSort( arch, datos, 1000, rs );
1056                    SelectionSort( arch, datos, 1000, ss );
1057                    InsertionSort( arch, datos, 1000, is );
1058                    ShellSort( arch, datos, 1000, sls );
1059                    ShellSortMej( arch, datos, 1000, slsm );
1060                    QuickSort( arch, datos, 1000, qs );
1061                    CrearInforme( DECRECIENTE );
1062              end
1063             else
1064             NoExisteArch;
1065        end;  { procedure EvaluarDec }
1066
1067     (*********************************************************)
1068
1069     var { procedure MenuEvaluar }
1070        tecla: char;
1071
1072     begin
1073          clrscr;
1074          textcolor( Yellow );
1075          gotoxy( 19, 3 );
1076          writeln( 'COMPARACION DE ALGORITMOS DE ORDENAMIENTO' );
1077          gotoxy( 19, 4 );
1078          writeln( '~~~~~~~~~~~ ~~ ~~~~~~~~~~ ~~ ~~~~~~~~~~~~' );
1079          textcolor( LightCyan );
1080          gotoxy( 1, 7 );
1081          writeln( '  Evaluar Algoritmos:' );
1082          writeln( '  ------- ----------' );
1083          textcolor( LightGray );
1084          writeln;
1085          writeln;
1086          writeln( '     1.- Ordenando en forma creciente.' );
1087          writeln( '     2.- Ordenando en forma decreciente.' );
1088          writeln( '     0.- Men£ Anterior.' );
1089          gotoxy( 1, 20 );
1090          textcolor( White );
1091          write( '  Ingrese su opci¢n: ' );
1092          textcolor( Yellow );
1093          tecla := readkey;
1094          while ( ( tecla < '1' ) or ( tecla > '2' ) ) and ( tecla <> '0' ) do
1095            begin
1096                 textcolor( White );
1097                 gotoxy( 1, 20 );
1098                 write( '  Ingrese su opci¢n (1, 2 o 0): ' );
1099                 textcolor( Yellow );
1100                 tecla := readkey;
1101            end;
1102          case tecla of
1103             '1': if ExisteArchivo( 'DATOS.TXT' ) then EvaluarCre( datos, arch )
1104                                                  else NoExisteArch;
1105             '2': if ExisteArchivo( 'DATOS.TXT' ) then EvaluarDec( datos, arch )
1106                                                  else NoExisteArch;
1107             '0': ;
1108          end;
1109     end;
1110
1111 (*********************************************************)
1112 (*********************************************************)
1113
1114  procedure MenuGenerar( var arch: text );
1115
1116     type
1117         TIPO_LETRA = ( TL_VOCAL, TL_CONSO );
1118         TIPO_VOCAL = ( TV_AEIOU, TV_EI );
1119         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 );
1120
1121     (*********************************************************)
1122
1123     function GetRNDApellido( max, min: integer ): APELLIDO;
1124
1125        (*********************************************************)
1126
1127        function GetVocal( tipo: TIPO_VOCAL ): char;
1128
1129          var
1130             valor: integer;
1131
1132          begin
1133               if tipo = TV_AEIOU then valor := random( 16 )
1134                                  else valor := random( 6 ) + 5;
1135               case valor of
1136                   0..4: GetVocal := 'A';
1137                   5..7: GetVocal := 'E';
1138                   8..10: GetVocal := 'I';
1139                  11..13: GetVocal := 'O';
1140                  14..15: GetVocal := 'U';
1141               end;
1142          end; { function GetVocal }
1143
1144        (*********************************************************)
1145
1146        procedure GetRNDVocal( var indic: INDICADOR; var proxl: TIPO_LETRA; var vocal: char );
1147
1148          var
1149             valor: integer;
1150
1151           begin
1152               case indic of
1153                   I_ESQ:
1154                         begin
1155                              vocal := 'U';
1156                              indic := I_ESQU;
1157                              proxl := TL_VOCAL;
1158                         end;
1159                   I_ESQU:
1160                          begin
1161                               vocal := GetVocal( TV_EI );
1162                               indic := I_NADA;
1163                               proxl := TL_CONSO;
1164                          end;
1165                   else
1166                     begin
1167                          vocal := GetVocal( TV_AEIOU );
1168                          indic := I_NADA;
1169                          if random( 40 ) = 0 then proxl := TL_VOCAL
1170                                              else proxl := TL_CONSO;
1171                     end;
1172                   end;
1173           end; { procedure GetRNDVocal }
1174
1175        (*********************************************************)
1176
1177        procedure GetRNDConsonante( var indic: INDICADOR; var proxl: TIPO_LETRA; var conso: char );
1178
1179           var
1180              valor: integer;
1181
1182           begin
1183                proxl := TL_VOCAL;
1184                indic := I_NADA;
1185
1186                case indic of
1187                   I_ESF, I_ESR, I_ESG, I_EST: conso := 'R';
1188                   I_ESB: case random( 2 ) of
1189                              0: conso := 'R';
1190                              1: conso := 'L';
1191                          end;
1192                   I_ESC: case random( 4 ) of
1193                              0: conso := 'C';
1194                              1: conso := 'H';
1195                              2: conso := 'R';
1196                              3: conso := 'L';
1197                          end;
1198                   I_ESL: case random( 6 ) of
1199                              0: conso := 'T';
1200                              1..5: conso := 'L';
1201                          end;
1202                   I_ESM: case random( 3 ) of
1203                              0: conso := 'P';
1204                              1: conso := 'B';
1205                              2: conso := 'L';
1206                          end;
1207                   I_ESN: case random( 3 ) of
1208                              0: conso := 'R';
1209                              1: conso := 'V';
1210                              2: conso := 'C';
1211                          end;
1212                   else case random( 55 ) of
1213                            0..3: begin
1214                                       conso := 'B';
1215                                       if random( 10 ) = 0 then begin
1216                                                                     indic := I_ESB;
1217                                                                     proxl := TL_CONSO;
1218                                                                end;
1219                                  end;
1220                            4..7: begin
1221                                       conso := 'C';
1222                                       if random( 5 ) = 0 then begin
1223                                                                     indic := I_ESC;
1224                                                                     proxl := TL_CONSO;
1225                                                                end;
1226                                  end;
1227                            8..11: conso := 'D';
1228                            12..14: begin
1229                                       conso := 'F';
1230                                       if random( 10 ) = 0 then begin
1231                                                                     indic := I_ESF;
1232                                                                     proxl := TL_CONSO;
1233                                                                end;
1234                                    end;
1235                            15..17: begin
1236                                         conso := 'G';
1237                                         if random( 5 ) = 0 then
1238                                         begin
1239                                              indic := I_ESG;
1240                                              if random( 4 ) = 0 then proxl := TL_CONSO;
1241                                         end;
1242                                    end;
1243                            18..19: conso := 'H';
1244                            20..22: conso := 'J';
1245                            23..24: conso := 'K';
1246                            25..27: begin
1247                                         conso := 'L';
1248                                         if random( 15 ) = 0 then
1249                                           begin
1250                                                indic := I_ESL;
1251                                                proxl := TL_CONSO;
1252                                           end;
1253                                    end;
1254                            28..30: begin
1255                                         conso := 'M';
1256                                         if random( 5 ) = 0 then
1257                                           begin
1258                                                indic := I_ESM;
1259                                                proxl := TL_CONSO;
1260                                           end;
1261                                    end;
1262                            31..33: begin
1263                                         conso := 'N';
1264                                         if random( 5 ) = 0 then
1265                                           begin
1266                                                indic := I_ESN;
1267                                                proxl := TL_CONSO;
1268                                           end;
1269                                    end;
1270                            34..36: conso := 'P';
1271                            37..38: begin
1272                                         conso := 'Q';
1273                                         indic := I_ESQ;
1274                                    end;
1275                            39..41: begin
1276                                         conso := 'R';
1277                                         if random( 3 ) = 0 then
1278                                           begin
1279                                                indic := I_ESR;
1280                                                proxl := TL_CONSO;
1281                                           end;
1282                                    end;
1283                            42..44: conso := 'S';
1284                            45..47: begin
1285                                         conso := 'T';
1286                                         if random( 10 ) = 0 then
1287                                           begin
1288                                                indic := I_EST;
1289                                                proxl := TL_CONSO;
1290                                           end;
1291                                    end;
1292                            48..50: conso := 'V';
1293                            51: conso := 'W';
1294                            52: conso := 'X';
1295                            53: conso := 'Y';
1296                            54: conso := 'Z';
1297                          end; { case random( 55 ) of }
1298
1299                 end; { case indic of }
1300            end; { procedure GetRNDConsonante }
1301
1302        (*********************************************************)
1303
1304        var { function GetRNDApellido }
1305           tam, i: integer;
1306           aux: char;
1307           apel: APELLIDO;
1308           indic: INDICADOR;
1309           proxl: TIPO_LETRA;
1310
1311        begin
1312             if max > MAX_APE then max := MAX_APE;
1313             tam := random( max + 1 ) + min;
1314             indic := I_NADA;
1315             apel := '';
1316             if random( 5 ) = 0 then proxl := TL_VOCAL
1317                                else proxl := TL_CONSO;
1318             for i := 1 to tam do
1319               begin
1320                    if proxl = TL_CONSO then GetRNDConsonante( indic, proxl, aux )
1321                                        else GetRNDVocal( indic, proxl, aux );
1322                    apel := apel + aux;
1323               end;
1324             GetRNDApellido := apel;
1325        end; { function GetRNDApellido }
1326
1327     (*********************************************************)
1328
1329     function GetRNDLetra( min, max: char ): char;
1330
1331        begin
1332             GetRNDLetra := chr( random( ord( max ) - ord( min ) + 1 ) + ord( min ) );
1333        end;
1334
1335     (*********************************************************)
1336
1337     procedure GetOrdApellidos( var ar: text; cant: integer );
1338
1339        var
1340            mil: boolean;
1341            letra, letra1: char;
1342            i, j, veces: integer;
1343            dni: DOCUMENTO;
1344            ap, ape, apel: APELLIDO;
1345
1346        begin
1347             mil := false;
1348             if cant = 1000 then mil := true;
1349             dni := 10000000 + (random( 15000 ) * 100);
1350             ap := '';
1351             ape := '';
1352             apel := '';
1353             for letra := 'A' to 'Z' do
1354               begin
1355                    ap := letra;
1356                    for letra1 := 'A' to 'Z' do
1357                       begin
1358                            if mil then
1359                               case letra of
1360                                    'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T':
1361                                         case letra1 of
1362                                              'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T', 'Z': veces := 2;
1363                                              else veces := 1;
1364                                         end;
1365                                    else case letra1 of
1366                                              'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T': veces := 2;
1367                                              else veces := 1;
1368                                         end;
1369                               end
1370                            else
1371                               case letra of
1372                                    'A', 'B', 'C', 'D', 'E', 'F', 'I', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T', 'V':
1373                                         case letra1 of
1374                                              'D', 'F', 'G', 'H', 'I', 'J', 'K', 'U', 'V': veces := 2;
1375                                              else veces := 1;
1376                                         end;
1377                                    else case letra1 of
1378                                              'D', 'F', 'G', 'H', 'I', 'J', 'K', 'U': veces := 2;
1379                                              else veces := 1;
1380                                         end;
1381                               end;
1382                            ape := ap + letra1;
1383                            for j := 1 to veces do
1384                                begin
1385                                     if j = 1 then apel := ape + GetRNDLetra( 'A', 'M' ) + GetRNDApellido( 6, 1 )
1386                                              else apel := ape + GetRNDLetra( 'N', 'Z' ) + GetRNDApellido( 6, 1 );
1387                                     dni := dni + random( 50000 ) + 1;
1388                                     writeln( ar, apel );
1389                                     apel := '';
1390                                end;
1391
1392                            ape := '';
1393
1394                       end; { for letra1 := 'A' to 'Z' do }
1395
1396                    ap := '';
1397
1398               end; { for letra := 'A' to 'Z' do }
1399
1400        end; { procedure GetOrdApellidos }
1401
1402     (*********************************************************)
1403
1404     procedure GetInvOrdApellidos( var ar: text; cant: integer );
1405
1406        var
1407           mil: boolean;
1408           letra, letra1: char;
1409           i, j, veces: integer;
1410           dni: DOCUMENTO;
1411           ap, ape, apel: APELLIDO;
1412
1413        begin
1414             mil := false;
1415             if cant = 1000 then mil := true;
1416             dni := 34000000 + (random( 15000 ) * 100);
1417             ap := '';
1418             ape := '';
1419             apel := '';
1420             for letra := 'Z' downto 'A' do
1421               begin
1422                    ap := letra;
1423                    for letra1 := 'Z' downto 'A' do
1424                       begin
1425                            if mil then
1426                               case letra of
1427                                    'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T':
1428                                         case letra1 of
1429                                              'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T', 'Z': veces := 2;
1430                                              else veces := 1;
1431                                         end;
1432                                    else case letra1 of
1433                                              'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T': veces := 2;
1434                                              else veces := 1;
1435                                         end;
1436                               end
1437                            else
1438                               case letra of
1439                                    'A', 'B', 'C', 'D', 'E', 'F', 'I', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T', 'V':
1440                                         case letra1 of
1441                                              'D', 'F', 'G', 'H', 'I', 'J', 'K', 'U', 'V': veces := 2;
1442                                              else veces := 1;
1443                                         end;
1444                                    else case letra1 of
1445                                              'D', 'F', 'G', 'H', 'I', 'J', 'K', 'U': veces := 2;
1446                                              else veces := 1;
1447                                         end;
1448                               end;
1449                            ape := ap + letra1;
1450                            for j := 1 to veces do
1451                                begin
1452                                     if j <> 1 then apel := ape + GetRNDLetra( 'A', 'M' ) + GetRNDApellido( 6, 1 )
1453                                               else apel := ape + GetRNDLetra( 'N', 'Z' ) + GetRNDApellido( 6, 1 );
1454                                     dni := dni - random( 40000 ) - 1;
1455                                     writeln( ar, apel );
1456                                     apel := '';
1457                                end;
1458
1459                            ape := '';
1460
1461                       end; { for letra1 := 'A' to 'Z' do }
1462
1463                    ap := '';
1464
1465               end; { for letra := 'A' to 'Z' do }
1466
1467        end; { GetInvOrdApellidos }
1468
1469
1470     (*********************************************************)
1471
1472     procedure GenerarRND( var arch: text; n: longint; reabrir: boolean );
1473
1474        var
1475           i: integer;
1476           ap: APELLIDO;
1477
1478        begin
1479             if reabrir then rewrite( arch );
1480
1481             for i := 1 to n do
1482                 begin
1483                      ap := GetRNDApellido( 30, 4 );
1484                      writeln( arch, ap );
1485                 end;
1486             if reabrir then close( arch );
1487        end; { procedure GenerarRND }
1488
1489     (*********************************************************)
1490
1491     procedure GenerarOrd( var arch: text; n: integer; reabrir: boolean );
1492
1493        begin
1494             if reabrir then rewrite( arch );
1495             GetOrdApellidos( arch, n );
1496             if reabrir then close( arch );
1497        end;
1498
1499     (*********************************************************)
1500
1501     procedure GenerarOrdDec( var arch: text; n: integer; reabrir: boolean );
1502
1503        begin
1504             if reabrir then rewrite( arch );
1505             GetInvOrdApellidos( arch, n );
1506             if reabrir then close( arch );
1507        end;
1508
1509     (*********************************************************)
1510
1511     procedure Generar90Ord( var arch: text );
1512
1513        begin
1514             rewrite( arch );
1515             GenerarOrd( arch, 900, false );
1516             GenerarRND( arch, 100, false );
1517             close( arch );
1518        end;
1519
1520     (*********************************************************)
1521
1522     procedure Generar90OrdDec( var arch: text );
1523
1524        begin
1525             rewrite( arch );
1526             GenerarOrdDec( arch, 900, false );
1527             GenerarRND( arch, 100, false );
1528             close( arch );
1529        end;
1530
1531     (*********************************************************)
1532
1533     var { procedure MenuGenerar }
1534        tecla: char;
1535
1536     begin
1537          clrscr;
1538          textcolor( Yellow );
1539          gotoxy( 19, 3 );
1540          writeln( 'COMPARACION DE ALGORITMOS DE ORDENAMIENTO' );
1541          gotoxy( 19, 4 );
1542          writeln( '~~~~~~~~~~~ ~~ ~~~~~~~~~~ ~~ ~~~~~~~~~~~~' );
1543          textcolor( LightCyan );
1544          gotoxy( 1, 7 );
1545          writeln( '  Generar Archivo (''DATOS.TXT''):' );
1546          writeln( '  ------- ------- -------------' );
1547          textcolor( LightGray );
1548          writeln;
1549          writeln;
1550          writeln( '     1.- Con datos desordenados.' );
1551          writeln( '     2.- Con datos en orden creciente (APELLIDO, DNI).' );
1552          writeln( '     3.- Con datos en orden decreciente (APELLIDO, DNI).' );
1553          writeln( '     4.- Con 90% datos en orden creciente (APELLIDO, DNI) + 10% desordenado.' );
1554          writeln( '     5.- Con 90% datos en orden decreciente (APELLIDO, DNI) + 10% desordenado.' );
1555          writeln( '     0.- Men£ Anterior.' );
1556          gotoxy( 1, 20 );
1557          textcolor( White );
1558          write( '  Ingrese su opci¢n: ' );
1559          textcolor( Yellow );
1560          tecla := readkey;
1561          while ( ( tecla < '1' ) or ( tecla > '5' ) ) and ( tecla <> '0' ) do
1562            begin
1563                 textcolor( White );
1564                 gotoxy( 1, 20 );
1565                 write( '  Ingrese su opci¢n (1 a 5 o 0): ' );
1566                 textcolor( Yellow );
1567                 tecla := readkey;
1568            end;
1569          case tecla of
1570             '1': GenerarRND( arch, 1000000, true );
1571             '2': GenerarOrd( arch, 1000, true );
1572             '3': GenerarOrdDec( arch, 1000, true );
1573             '4': Generar90Ord( arch );
1574             '5': Generar90OrdDec( arch );
1575             '0': ;
1576          end;
1577     end; { procedure MenuGenerar }
1578
1579 (*********************************************************)
1580
1581  procedure PantallaSalida;
1582
1583     begin
1584          writeln;
1585          NormVideo;
1586          clrscr;
1587          writeln;
1588          textcolor( white );
1589          writeln( ' COMPARACION DE ALGORITMOS DE ORDENAMIENTO versi¢n ', VERSION, ' <-o-o-> Luca - Soft' );
1590          NormVideo;
1591          writeln( '  Desarrollado por Leandro Lucarella para la Facultad de Ingenier¡a de la' );
1592          writeln( '  Universidad de Buenos Aires. Consultas, sugerencias y/o reprobaciones a:' );
1593          writeln;
1594          textcolor( LightMagenta );
1595          write( '                lluca@cnba.uba.ar' );
1596          NormVideo;
1597          write( '   o   ' );
1598          textcolor( LightMagenta );
1599          writeln( 'lluca@geocities.com' );
1600          NormVideo;
1601          writeln;
1602          writeln( '  (c) 1999 - Todos los derechos reservados.' );
1603          delay( 750 );
1604     end;
1605
1606 (*********************************************************)
1607
1608 var { programa }
1609     datos: TABLA;
1610     arch: text;
1611     tecla: char;
1612     salir: boolean;
1613
1614 begin
1615      randomize;
1616      assign( arch, 'DATOS.TXT' );
1617      salir := false;
1618      textbackground( Blue );
1619
1620      while not salir do
1621        begin
1622             clrscr;
1623             textcolor( Yellow );
1624             gotoxy( 19, 3 );
1625             writeln( 'COMPARACION DE ALGORITMOS DE ORDENAMIENTO' );
1626             gotoxy( 19, 4 );
1627             writeln( '~~~~~~~~~~~ ~~ ~~~~~~~~~~ ~~ ~~~~~~~~~~~~' );
1628             gotoxy( 1, 7 );
1629             textcolor( LightCyan );
1630             writeln( '  Men£ Principal:' );
1631             writeln( '  ---- ---------' );
1632             textcolor( LightGray );
1633             writeln;
1634             writeln;
1635             writeln( '     1.- Generar Archivo (''DATOS.TXT'').' );
1636             writeln( '     2.- Evaluar Algoritmos.' );
1637             writeln( '     0.- Salir.' );
1638             gotoxy( 1, 20 );
1639             textcolor( White );
1640             write( '  Ingrese su opci¢n: ' );
1641             textcolor( Yellow );
1642             tecla := readkey;
1643             while ( ( tecla < '1' ) or ( tecla > '2' ) ) and ( tecla <> '0' ) do
1644               begin
1645                    textcolor( White );
1646                    gotoxy( 1, 20 );
1647                    write( '  Ingrese su opci¢n (1, 2 o 0): ' );
1648                    textcolor( Yellow );
1649                    tecla := readkey;
1650               end;
1651             case tecla of
1652                  '1': MenuGenerar( arch );
1653                  '2': MenuEvaluar( datos, arch );
1654                  '0': salir := true;
1655             end;
1656        end;
1657      PantallaSalida;
1658 end.