src/comp.pas

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