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.