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