test/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 \r
   9 type\r
  10     APELLIDO = string[MAX_APE];\r
  11     DOCUMENTO = longint;\r
  12     PERSONA = record\r
  13                     ap: APELLIDO;\r
  14                     dni: DOCUMENTO;\r
  15               end;\r
  16     HORA = record\r
  17                  h,\r
  18                  m,\r
  19                  s,\r
  20                  c: longint;\r
  21            end;\r
  22     TABLA = array[1..1000] of PERSONA;\r
  23     TIPO_LETRA = ( TL_VOCAL, TL_CONSO );\r
  24     TIPO_VOCAL = ( TV_AEIOU, TV_EI );\r
  25     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
  26 \r
  27 (*********************************************************)\r
  28 \r
  29  procedure CargarArchivo( var datos: TABLA; var ar: text; tam: integer );\r
  30 \r
  31     var\r
  32        i: integer;\r
  33 \r
  34     begin\r
  35          for i:= 1 to tam do\r
  36             begin\r
  37                  writeln( ar, datos[i].ap );\r
  38                  writeln( ar, datos[i].dni );\r
  39                  writeln( ar );\r
  40             end;\r
  41     end;\r
  42 \r
  43 (*********************************************************)\r
  44 (*********************************************************)\r
  45 \r
  46  procedure MenuEvaluar( var datos: TABLA; var arch: text );\r
  47 \r
  48     (*********************************************************)\r
  49 \r
  50     procedure NoExisteArch;\r
  51 \r
  52        begin\r
  53             clrscr;\r
  54             gotoxy( 20, 10 );\r
  55             textcolor( LightMagenta + Blink );\r
  56             writeln( 'ERROR: No existe el archivo a evaluar!' );\r
  57             textcolor( LightGray );\r
  58             writeln;\r
  59             writeln( '             Creelo seleccionando la opci¢n 1 del Men£ Principal.' );\r
  60             delay( 4000 );\r
  61        end; { procedure NoExisteArch }\r
  62 \r
  63     (*********************************************************)\r
  64 \r
  65     function ExisteArchivo( nombre: String ): boolean;\r
  66                           { funcion extrido de la ayuda del pascal }\r
  67        var\r
  68           arch: text;\r
  69 \r
  70        begin\r
  71             {$I-}\r
  72             Assign( arch, nombre );\r
  73             FileMode := 0;  { Solo lectura }\r
  74             Reset( arch );\r
  75             Close( arch );\r
  76             {$I+}\r
  77             ExisteArchivo := (IOResult = 0) and (nombre <> '');\r
  78        end; { function ExisteArchivo }\r
  79 \r
  80     (*********************************************************)\r
  81 \r
  82        procedure CargarTabla( var ar: text; var datos: TABLA; tam: integer );\r
  83 \r
  84           var\r
  85              i: integer;\r
  86              void: string[2];\r
  87 \r
  88           begin\r
  89                for i:= 1 to tam do\r
  90                   begin\r
  91                        readln( ar, datos[i].ap );\r
  92                        readln( ar, datos[i].dni );\r
  93                       readln( ar, void );\r
  94                   end;\r
  95           end; { procedure CargarTabla }\r
  96 \r
  97     (*********************************************************)\r
  98 \r
  99     procedure Intercambiar( var a, b: PERSONA; var int: longint );\r
 100 \r
 101        var\r
 102           aux: PERSONA;\r
 103 \r
 104        begin\r
 105             int := int + 1;\r
 106             aux := a;\r
 107             a := b;\r
 108             b := aux;\r
 109           {  delay( 1 );}\r
 110        end; { procedure Intercambiar }\r
 111 \r
 112     (*********************************************************)\r
 113 \r
 114     procedure GetHora( var hor: HORA );\r
 115 \r
 116        var\r
 117           h, m, s, c: word;\r
 118 \r
 119        begin\r
 120             gettime( h, m, s, c );\r
 121             hor.h := h;\r
 122             hor.m := m;\r
 123             hor.s := s;\r
 124             hor.c := c;\r
 125        end; { procedure GetHora }\r
 126 \r
 127     (*********************************************************)\r
 128 \r
 129     function GetTiempo( h1, h2: HORA ): longint;\r
 130 \r
 131        var\r
 132           t: longint;\r
 133           aux: HORA;\r
 134 \r
 135        begin\r
 136             if h1.h <> h2.h then { pone al menor como h2 y al mayor como h1 }\r
 137               begin\r
 138               if h1.h < h2.h then\r
 139                 begin\r
 140                      aux := h1;\r
 141                      h1 := h2;\r
 142                      h2 := aux;\r
 143                 end\r
 144               end\r
 145             else if h1.m <> h2.m then\r
 146                    begin\r
 147                    if h1.m < h2.m then\r
 148                      begin\r
 149                           aux := h1;\r
 150                           h1 := h2;\r
 151                           h2 := aux;\r
 152                      end\r
 153                    end\r
 154                  else if h1.s <> h2.s then\r
 155                         begin\r
 156                         if h1.s < h2.s then\r
 157                           begin\r
 158                                aux := h1;\r
 159                                h1 := h2;\r
 160                                h2 := aux;\r
 161                           end\r
 162                         end\r
 163                       else if h1.c <> h2.c then\r
 164                              if h1.c < h2.c then\r
 165                                begin\r
 166                                     aux := h1;\r
 167                                     h1 := h2;\r
 168                                     h2 := aux;\r
 169                                end;\r
 170             t := ( ( ( h1.h - h2.h ) * 60 + ( h1.m - h2.m ) ) * 60  + ( h1.s - h2.s ) ) * 100 + ( h1.c - h2.c );\r
 171             GetTiempo := t;\r
 172        end; { function GetTiempo }\r
 173 \r
 174     (*********************************************************)\r
 175 \r
 176     procedure EvaluarCre( var datos: TABLA; var arch: text );\r
 177 \r
 178        (*********************************************************)\r
 179 \r
 180        procedure BubbleSort( var arch: text; var datos: TABLA; tam: integer;\r
 181                              var comparaciones: longint; var intercambios: longint; var tiempo: longint );\r
 182 \r
 183           var\r
 184              i, j: integer;\r
 185              h1, h2: HORA;\r
 186 \r
 187           begin\r
 188                GetHora( h1 );\r
 189                comparaciones := 0;\r
 190                intercambios := 0;\r
 191                reset( arch );\r
 192                CargarTabla( arch, datos, 1000 );\r
 193                close( arch );\r
 194                for i := tam - 1 downto 1 do\r
 195                begin\r
 196                     for j := tam - 1 downto 1 do\r
 197                       begin\r
 198                            comparaciones := comparaciones + 1;\r
 199                          {  delay( 1 );}\r
 200                            if datos[j].ap > datos[j+1].ap then\r
 201                              Intercambiar( datos[j], datos[j+1], intercambios);\r
 202                       end;\r
 203                end;\r
 204              GetHora( h2 );\r
 205              tiempo := GetTiempo( h1, h2 );\r
 206         end; { procedure BubbleSort }\r
 207 \r
 208        (*********************************************************)\r
 209 \r
 210        procedure BubbleSortMej( var arch: text; var datos: TABLA; tam: integer;\r
 211                                 var comparaciones: longint; var intercambios: longint; var tiempo: longint );\r
 212 \r
 213           var\r
 214              huboint: boolean;\r
 215              i, n: integer;\r
 216              h1, h2: HORA;\r
 217 \r
 218           begin\r
 219                GetHora( h1 );\r
 220                comparaciones := 0;\r
 221                intercambios := 0;\r
 222                n := 1;\r
 223                reset( arch );\r
 224                CargarTabla( arch, datos, 1000 );\r
 225                close( arch );\r
 226                huboint := true;\r
 227                while huboint do\r
 228                  begin\r
 229                       huboint := false;\r
 230                       for i := tam - 1 downto n do\r
 231                         begin\r
 232                              comparaciones := comparaciones + 1;\r
 233                            {  delay( 1 );}\r
 234                              if datos[i].ap > datos[i+1].ap then\r
 235                                begin\r
 236                                     Intercambiar( datos[i], datos[i+1], intercambios);\r
 237                                     huboint := true;\r
 238                                end;\r
 239                         end;\r
 240                       n := n + 1;\r
 241                  end;\r
 242                GetHora( h2 );\r
 243                tiempo := GetTiempo( h1, h2 );\r
 244           end; { procedure BubbleSortMej }\r
 245 \r
 246        (*********************************************************)\r
 247 \r
 248        procedure SelectionSort( var arch: text; var datos: TABLA; tam: integer;\r
 249                                 var comparaciones: longint; var intercambios: longint; var tiempo: longint );\r
 250           var\r
 251              i, sel, n: integer;\r
 252              hubosel: boolean;\r
 253              h1, h2: HORA;\r
 254 \r
 255           begin\r
 256                GetHora( h1 );\r
 257                comparaciones := 0;\r
 258                intercambios := 0;\r
 259                reset( arch );\r
 260                CargarTabla( arch, datos, 1000 );\r
 261                close( arch );\r
 262                for n := 1 to tam - 1 do\r
 263                  begin\r
 264                       hubosel := false;\r
 265                       sel := n;\r
 266                       for i := n + 1 to tam do\r
 267                         begin\r
 268                              comparaciones := comparaciones + 1;\r
 269                            {  delay( 1 );  }\r
 270                              if datos[sel].ap > datos[i].ap then\r
 271                                begin\r
 272                                     sel := i;\r
 273                                     hubosel := true;\r
 274                                end;\r
 275                         end;\r
 276                       if hubosel then Intercambiar( datos[n], datos[sel], intercambios);\r
 277                  end;\r
 278                GetHora( h2 );\r
 279                tiempo := GetTiempo( h1, h2 );\r
 280           end; { procedure SelectionSort }\r
 281 \r
 282        (*********************************************************)\r
 283 \r
 284        procedure QuickSort( var arch: text; var datos: TABLA; tam: integer;\r
 285                             var comparaciones: longint; var intercambios: longint; var tiempo: longint );\r
 286 \r
 287           procedure QSort( var datos: TABLA; min, max: integer;\r
 288                            var comp: longint; var int: longint );\r
 289 \r
 290              var\r
 291                 i, j: integer;\r
 292                 sel: PERSONA;\r
 293                 flag: boolean;\r
 294 \r
 295              begin\r
 296                   sel := datos[( min + max ) div 2];\r
 297                   i := min;\r
 298                   j := max;\r
 299                   repeat\r
 300                         comp := comp + 1;\r
 301                       {  delay( 1 );}\r
 302                         flag := false;\r
 303                         while datos[i].ap < sel.ap do\r
 304                           begin\r
 305                                if flag then begin\r
 306                                                  comp := comp + 1;\r
 307                                                {  delay( 1 );}\r
 308                                             end\r
 309                                        else flag := true;\r
 310                                i := i + 1;\r
 311                           end;\r
 312                         comp := comp + 1;\r
 313                       {  delay( 1 );}\r
 314                         flag := false;\r
 315                         while datos[j].ap > sel.ap do\r
 316                           begin\r
 317                                if flag then begin\r
 318                                                  comp := comp + 1;\r
 319                                               {   delay( 1 );}\r
 320                                             end\r
 321                                        else flag := true;\r
 322                                j := j - 1;\r
 323                           end;\r
 324                         if i <= j then\r
 325                           begin\r
 326                                if i < j then Intercambiar( datos[i], datos[j], int );\r
 327                                i := i + 1;\r
 328                                j := j - 1;\r
 329                           end;\r
 330                   until i > j;\r
 331                   if min < j then QSort( datos, min, j, comp, int);\r
 332                   if i < max then QSort( datos, i, max, comp, int);\r
 333              end; { procedure QSort }\r
 334 \r
 335           (*********************************************************)\r
 336 \r
 337           var\r
 338              h1, h2: HORA;\r
 339 \r
 340           begin { procedure QuickSort }\r
 341                GetHora( h1 );\r
 342                comparaciones := 0;\r
 343                intercambios := 0;\r
 344                reset( arch );\r
 345                CargarTabla( arch, datos, 1000 );\r
 346                close( arch );\r
 347                QSort( datos, 1, 1000, comparaciones, intercambios );\r
 348                GetHora( h2 );\r
 349                tiempo := GetTiempo( h1, h2 );\r
 350                rewrite( arch );\r
 351                CargarArchivo( datos, arch, 1000 );\r
 352                close( arch );\r
 353           end; { procedure QuickSort }\r
 354 \r
 355        (*********************************************************)\r
 356 \r
 357        var { procedure EvaluarCre }\r
 358           bsComp, bsInt, bsTiem,\r
 359           bsmComp, bsmInt, bsmTiem,\r
 360           ssComp, ssInt, ssTiem,\r
 361           qsComp, qsInt, qsTiem: longint;\r
 362           info: text;\r
 363 \r
 364        begin\r
 365             assign( info, 'INFORME.TXT' );\r
 366             if ExisteArchivo( 'DATOS.TXT' ) then\r
 367               begin\r
 368                    BubbleSort( arch, datos, 1000, bsComp, bsInt, bsTiem );\r
 369                    BubbleSortMej( arch, datos, 1000, bsmComp, bsmInt, bsmTiem );\r
 370                    SelectionSort( arch, datos, 1000, ssComp, ssInt, ssTiem );\r
 371                    QuickSort( arch, datos, 1000, qsComp, qsInt, qsTiem );\r
 372                    rewrite( info );\r
 373                    writeln( info, 'Bubble Sort:' );\r
 374                    writeln( info, '             Comparaciones: ', bsComp: 1 );\r
 375                    writeln( info, '             Intercambios:  ', bsInt: 1 );\r
 376                    writeln( info, '             Tiempo (seg):  ', bsTiem / 100: 2: 2 );\r
 377                    writeln( info );\r
 378                    writeln( info, 'Bubble Sort Mejorado:' );\r
 379                    writeln( info, '             Comparaciones: ', bsmComp: 1 );\r
 380                    writeln( info, '             Intercambios:  ', bsmInt: 1 );\r
 381                    writeln( info, '             Tiempo (seg):  ', bsmTiem / 100: 2: 2 );\r
 382                    writeln( info );\r
 383                    writeln( info, 'Selection Sort:' );\r
 384                    writeln( info, '             Comparaciones: ', ssComp: 1 );\r
 385                    writeln( info, '             Intercambios:  ', ssInt: 1 );\r
 386                    writeln( info, '             Tiempo (seg):  ', ssTiem / 100: 2: 2 );\r
 387                    writeln( info );\r
 388                    writeln( info, 'Quick Sort:' );\r
 389                    writeln( info, '             Comparaciones: ', qsComp: 1 );\r
 390                    writeln( info, '             Intercambios:  ', qsInt: 1 );\r
 391                    writeln( info, '             Tiempo (seg): ', qsTiem / 100: 2: 2 );\r
 392                    writeln( info );\r
 393                    close( info );\r
 394               end\r
 395             else\r
 396             NoExisteArch;\r
 397        end; { procedure EvaluarCre }\r
 398 \r
 399     (*********************************************************)\r
 400 \r
 401     procedure EvaluarDec( var datos: TABLA; var arch: text );\r
 402 \r
 403        var nada: integer;\r
 404 \r
 405        begin\r
 406             for nada := 1 to 1000 do\r
 407                 writeln( datos[nada].ap, ' ', datos[nada].dni );\r
 408             delay( 3000 );\r
 409        end;\r
 410 \r
 411     (*********************************************************)\r
 412 \r
 413     var { procedure MenuEvaluar }\r
 414        tecla: char;\r
 415 \r
 416     begin\r
 417          clrscr;\r
 418          textcolor( Yellow );\r
 419          gotoxy( 19, 3 );\r
 420          writeln( 'COMPARACION DE ALGORITMOS DE ORDENAMIENTO' );\r
 421          gotoxy( 19, 4 );\r
 422          writeln( '~~~~~~~~~~~ ~~ ~~~~~~~~~~ ~~ ~~~~~~~~~~~~' );\r
 423          textcolor( LightCyan );\r
 424          gotoxy( 1, 7 );\r
 425          writeln( '  Evaluar Algoritmos:' );\r
 426          writeln( '  ------- ----------' );\r
 427          textcolor( LightGray );\r
 428          writeln;\r
 429          writeln;\r
 430          writeln( '     1.- Ordenando en forma creciente.' );\r
 431          writeln( '     2.- Ordenando en forma decreciente.' );\r
 432          writeln( '     0.- Men£ Anterior.' );\r
 433          gotoxy( 1, 20 );\r
 434          textcolor( White );\r
 435          write( '  Ingrese su opci¢n: ' );\r
 436          textcolor( Yellow );\r
 437          tecla := readkey;\r
 438          while ( ( tecla < '1' ) or ( tecla > '2' ) ) and ( tecla <> '0' ) do\r
 439            begin\r
 440                 textcolor( White );\r
 441                 gotoxy( 1, 20 );\r
 442                 write( '  Ingrese su opci¢n (1, 2 o 0): ' );\r
 443                 textcolor( Yellow );\r
 444                 tecla := readkey;\r
 445            end;\r
 446          case tecla of\r
 447             '1': if ExisteArchivo( 'DATOS.TXT' ) then EvaluarCre( datos, arch )\r
 448                                                  else NoExisteArch;\r
 449             '2': if ExisteArchivo( 'DATOS.TXT' ) then EvaluarDec( datos, arch )\r
 450                                                  else NoExisteArch;\r
 451             '0': ;\r
 452          end;\r
 453     end;\r
 454 \r
 455 (*********************************************************)\r
 456 (*********************************************************)\r
 457 \r
 458  procedure MenuGenerar( var arch: text );\r
 459 \r
 460     (*********************************************************)\r
 461 \r
 462     function GetRNDApellido( max, min: integer ): APELLIDO;\r
 463 \r
 464        (*********************************************************)\r
 465 \r
 466        function GetVocal( tipo: TIPO_VOCAL ): char;\r
 467 \r
 468          var\r
 469             valor: integer;\r
 470 \r
 471          begin\r
 472               if tipo = TV_AEIOU then valor := random( 16 )\r
 473                                  else valor := random( 6 ) + 5;\r
 474               case valor of\r
 475                   0..4: GetVocal := 'A';\r
 476                   5..7: GetVocal := 'E';\r
 477                   8..10: GetVocal := 'I';\r
 478                  11..13: GetVocal := 'O';\r
 479                  14..15: GetVocal := 'U';\r
 480               end;\r
 481          end; { function GetVocal }\r
 482 \r
 483        (*********************************************************)\r
 484 \r
 485        procedure GetRNDVocal( var indic: INDICADOR; var proxl: TIPO_LETRA; var vocal: char );\r
 486 \r
 487          var\r
 488             valor: integer;\r
 489 \r
 490           begin\r
 491               case indic of\r
 492                   I_ESQ:\r
 493                         begin\r
 494                              vocal := 'U';\r
 495                              indic := I_ESQU;\r
 496                              proxl := TL_VOCAL;\r
 497                         end;\r
 498                   I_ESQU:\r
 499                          begin\r
 500                               vocal := GetVocal( TV_EI );\r
 501                               indic := I_NADA;\r
 502                               proxl := TL_CONSO;\r
 503                          end;\r
 504                   else\r
 505                     begin\r
 506                          vocal := GetVocal( TV_AEIOU );\r
 507                          indic := I_NADA;\r
 508                          if random( 40 ) = 0 then proxl := TL_VOCAL\r
 509                                              else proxl := TL_CONSO;\r
 510                     end;\r
 511                   end;\r
 512           end; { procedure GetRNDVocal }\r
 513 \r
 514        (*********************************************************)\r
 515 \r
 516        procedure GetRNDConsonante( var indic: INDICADOR; var proxl: TIPO_LETRA; var conso: char );\r
 517 \r
 518           var\r
 519              valor: integer;\r
 520 \r
 521           begin\r
 522                proxl := TL_VOCAL;\r
 523                indic := I_NADA;\r
 524 \r
 525                case indic of\r
 526                   I_ESF, I_ESR, I_ESG, I_EST: conso := 'R';\r
 527                   I_ESB: case random( 2 ) of\r
 528                              0: conso := 'R';\r
 529                              1: conso := 'L';\r
 530                          end;\r
 531                   I_ESC: case random( 4 ) of\r
 532                              0: conso := 'C';\r
 533                              1: conso := 'H';\r
 534                              2: conso := 'R';\r
 535                              3: conso := 'L';\r
 536                          end;\r
 537                   I_ESL: case random( 6 ) of\r
 538                              0: conso := 'T';\r
 539                              1..5: conso := 'L';\r
 540                          end;\r
 541                   I_ESM: case random( 3 ) of\r
 542                              0: conso := 'P';\r
 543                              1: conso := 'B';\r
 544                              2: conso := 'L';\r
 545                          end;\r
 546                   I_ESN: case random( 3 ) of\r
 547                              0: conso := 'R';\r
 548                              1: conso := 'V';\r
 549                              2: conso := 'C';\r
 550                          end;\r
 551                   else case random( 55 ) of\r
 552                            0..3: begin\r
 553                                       conso := 'B';\r
 554                                       if random( 10 ) = 0 then begin\r
 555                                                                     indic := I_ESB;\r
 556                                                                     proxl := TL_CONSO;\r
 557                                                                end;\r
 558                                  end;\r
 559                            4..7: begin\r
 560                                       conso := 'C';\r
 561                                       if random( 5 ) = 0 then begin\r
 562                                                                     indic := I_ESC;\r
 563                                                                     proxl := TL_CONSO;\r
 564                                                                end;\r
 565                                  end;\r
 566                            8..11: conso := 'D';\r
 567                            12..14: begin\r
 568                                       conso := 'F';\r
 569                                       if random( 10 ) = 0 then begin\r
 570                                                                     indic := I_ESF;\r
 571                                                                     proxl := TL_CONSO;\r
 572                                                                end;\r
 573                                    end;\r
 574                            15..17: begin\r
 575                                         conso := 'G';\r
 576                                         if random( 5 ) = 0 then\r
 577                                         begin\r
 578                                              indic := I_ESG;\r
 579                                              if random( 4 ) = 0 then proxl := TL_CONSO;\r
 580                                         end;\r
 581                                    end;\r
 582                            18..19: conso := 'H';\r
 583                            20..22: conso := 'J';\r
 584                            23..24: conso := 'K';\r
 585                            25..27: begin\r
 586                                         conso := 'L';\r
 587                                         if random( 15 ) = 0 then\r
 588                                           begin\r
 589                                                indic := I_ESL;\r
 590                                                proxl := TL_CONSO;\r
 591                                           end;\r
 592                                    end;\r
 593                            28..30: begin\r
 594                                         conso := 'M';\r
 595                                         if random( 5 ) = 0 then\r
 596                                           begin\r
 597                                                indic := I_ESM;\r
 598                                                proxl := TL_CONSO;\r
 599                                           end;\r
 600                                    end;\r
 601                            31..33: begin\r
 602                                         conso := 'N';\r
 603                                         if random( 5 ) = 0 then\r
 604                                           begin\r
 605                                                indic := I_ESN;\r
 606                                                proxl := TL_CONSO;\r
 607                                           end;\r
 608                                    end;\r
 609                            34..36: conso := 'P';\r
 610                            37..38: begin\r
 611                                         conso := 'Q';\r
 612                                         indic := I_ESQ;\r
 613                                    end;\r
 614                            39..41: begin\r
 615                                         conso := 'R';\r
 616                                         if random( 3 ) = 0 then\r
 617                                           begin\r
 618                                                indic := I_ESR;\r
 619                                                proxl := TL_CONSO;\r
 620                                           end;\r
 621                                    end;\r
 622                            42..44: conso := 'S';\r
 623                            45..47: begin\r
 624                                         conso := 'T';\r
 625                                         if random( 10 ) = 0 then\r
 626                                           begin\r
 627                                                indic := I_EST;\r
 628                                                proxl := TL_CONSO;\r
 629                                           end;\r
 630                                    end;\r
 631                            48..50: conso := 'V';\r
 632                            51: conso := 'W';\r
 633                            52: conso := 'X';\r
 634                            53: conso := 'Y';\r
 635                            54: conso := 'Z';\r
 636                          end; { case random( 55 ) of }\r
 637 \r
 638                 end; { case indic of }\r
 639            end; { procedure GetRNDConsonante }\r
 640 \r
 641        (*********************************************************)\r
 642 \r
 643        var { function GetRNDApellido }\r
 644           tam, i: integer;\r
 645           aux: char;\r
 646           apel: APELLIDO;\r
 647           indic: INDICADOR;\r
 648           proxl: TIPO_LETRA;\r
 649 \r
 650        begin\r
 651             if max > MAX_APE then max := MAX_APE;\r
 652             tam := random( max + 1 ) + min;\r
 653             indic := I_NADA;\r
 654             apel := '';\r
 655             if random( 5 ) = 0 then proxl := TL_VOCAL\r
 656                                else proxl := TL_CONSO;\r
 657             for i := 1 to tam do\r
 658               begin\r
 659                    if proxl = TL_CONSO then GetRNDConsonante( indic, proxl, aux )\r
 660                                        else GetRNDVocal( indic, proxl, aux );\r
 661                    apel := apel + aux;\r
 662               end;\r
 663             GetRNDApellido := apel;\r
 664        end; { function GetRNDApellido }\r
 665 \r
 666     (*********************************************************)\r
 667 \r
 668     function GetRNDLetra( min, max: char ): char;\r
 669 \r
 670        begin\r
 671             GetRNDLetra := chr( random( ord( max ) - ord( min ) + 1 ) + ord( min ) );\r
 672        end;\r
 673 \r
 674     (*********************************************************)\r
 675 \r
 676     procedure GetOrdApellidos( var ar: text; cant: integer );\r
 677 \r
 678        var\r
 679            mil: boolean;\r
 680            letra, letra1: char;\r
 681            i, j, veces: integer;\r
 682            dni: DOCUMENTO;\r
 683            ap, ape, apel: APELLIDO;\r
 684 \r
 685        begin\r
 686             mil := false;\r
 687             if cant = 1000 then mil := true;\r
 688             dni := 10000000 + (random( 15000 ) * 100);\r
 689             ap := '';\r
 690             ape := '';\r
 691             apel := '';\r
 692             for letra := 'A' to 'Z' do\r
 693               begin\r
 694                    ap := letra;\r
 695                    for letra1 := 'A' to 'Z' do\r
 696                       begin\r
 697                            if mil then\r
 698                               case letra of\r
 699                                    'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T':\r
 700                                         case letra1 of\r
 701                                              'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T', 'Z': veces := 2;\r
 702                                              else veces := 1;\r
 703                                         end;\r
 704                                    else case letra1 of\r
 705                                              'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T': veces := 2;\r
 706                                              else veces := 1;\r
 707                                         end;\r
 708                               end\r
 709                            else\r
 710                               case letra of\r
 711                                    'A', 'B', 'C', 'D', 'E', 'F', 'I', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T', 'V':\r
 712                                         case letra1 of\r
 713                                              'D', 'F', 'G', 'H', 'I', 'J', 'K', 'U', 'V': veces := 2;\r
 714                                              else veces := 1;\r
 715                                         end;\r
 716                                    else case letra1 of\r
 717                                              'D', 'F', 'G', 'H', 'I', 'J', 'K', 'U': veces := 2;\r
 718                                              else veces := 1;\r
 719                                         end;\r
 720                               end;\r
 721                            ape := ap + letra1;\r
 722                            for j := 1 to veces do\r
 723                                begin\r
 724                                     if j = 1 then apel := ape + GetRNDLetra( 'A', 'M' ) + GetRNDApellido( 6, 1 )\r
 725                                              else apel := ape + GetRNDLetra( 'N', 'Z' ) + GetRNDApellido( 6, 1 );\r
 726                                     dni := dni + random( 50000 ) + 1;\r
 727                                     writeln( ar, apel );\r
 728                                     writeln( ar, dni );\r
 729                                     writeln( ar );\r
 730                                     apel := '';\r
 731                                end;\r
 732 \r
 733                            ape := '';\r
 734 \r
 735                       end; { for letra1 := 'A' to 'Z' do }\r
 736 \r
 737                    ap := '';\r
 738 \r
 739               end; { for letra := 'A' to 'Z' do }\r
 740 \r
 741        end; { procedure GetOrdApellidos }\r
 742 \r
 743     (*********************************************************)\r
 744 \r
 745     procedure GetInvOrdApellidos( var ar: text; cant: integer );\r
 746 \r
 747        var\r
 748           mil: boolean;\r
 749           letra, letra1: char;\r
 750           i, j, veces: integer;\r
 751           dni: DOCUMENTO;\r
 752           ap, ape, apel: APELLIDO;\r
 753 \r
 754        begin\r
 755             mil := false;\r
 756             if cant = 1000 then mil := true;\r
 757             dni := 34000000 + (random( 15000 ) * 100);\r
 758             ap := '';\r
 759             ape := '';\r
 760             apel := '';\r
 761             for letra := 'Z' downto 'A' do\r
 762               begin\r
 763                    ap := letra;\r
 764                    for letra1 := 'Z' downto 'A' do\r
 765                       begin\r
 766                            if mil then\r
 767                               case letra of\r
 768                                    'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T':\r
 769                                         case letra1 of\r
 770                                              'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T', 'Z': veces := 2;\r
 771                                              else veces := 1;\r
 772                                         end;\r
 773                                    else case letra1 of\r
 774                                              'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T': veces := 2;\r
 775                                              else veces := 1;\r
 776                                         end;\r
 777                               end\r
 778                            else\r
 779                               case letra of\r
 780                                    'A', 'B', 'C', 'D', 'E', 'F', 'I', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T', 'V':\r
 781                                         case letra1 of\r
 782                                              'D', 'F', 'G', 'H', 'I', 'J', 'K', 'U', 'V': veces := 2;\r
 783                                              else veces := 1;\r
 784                                         end;\r
 785                                    else case letra1 of\r
 786                                              'D', 'F', 'G', 'H', 'I', 'J', 'K', 'U': veces := 2;\r
 787                                              else veces := 1;\r
 788                                         end;\r
 789                               end;\r
 790                            ape := ap + letra1;\r
 791                            for j := 1 to veces do\r
 792                                begin\r
 793                                     if j <> 1 then apel := ape + GetRNDLetra( 'A', 'M' ) + GetRNDApellido( 6, 1 )\r
 794                                               else apel := ape + GetRNDLetra( 'N', 'Z' ) + GetRNDApellido( 6, 1 );\r
 795                                     dni := dni - random( 40000 ) - 1;\r
 796                                     writeln( ar, apel );\r
 797                                     writeln( ar, dni );\r
 798                                     writeln( ar );\r
 799                                     apel := '';\r
 800                                end;\r
 801 \r
 802                            ape := '';\r
 803 \r
 804                       end; { for letra1 := 'A' to 'Z' do }\r
 805 \r
 806                    ap := '';\r
 807 \r
 808               end; { for letra := 'A' to 'Z' do }\r
 809 \r
 810        end; { GetInvOrdApellidos }\r
 811 \r
 812 \r
 813     (*********************************************************)\r
 814 \r
 815     procedure GenerarRND( var arch: text; n: integer; reabrir: boolean );\r
 816 \r
 817        var\r
 818           i: integer;\r
 819           ap: APELLIDO;\r
 820           dni: DOCUMENTO;\r
 821 \r
 822        begin\r
 823             if reabrir then rewrite( arch );\r
 824             dni := 10000000 + (random( 15000 ) * 100);\r
 825 \r
 826             for i := 1 to n do\r
 827                 begin\r
 828                      ap := GetRNDApellido( 8, 4 );\r
 829                      dni := dni + random( 50000 ) + 1;\r
 830                      writeln( arch, ap );\r
 831                      writeln( arch, dni );\r
 832                      writeln( arch );\r
 833                 end;\r
 834             if reabrir then close( arch );\r
 835        end; { procedure GenerarRND }\r
 836 \r
 837     (*********************************************************)\r
 838 \r
 839     procedure GenerarOrd( var arch: text; n: integer; reabrir: boolean );\r
 840 \r
 841        begin\r
 842             if reabrir then rewrite( arch );\r
 843             GetOrdApellidos( arch, n );\r
 844             if reabrir then close( arch );\r
 845        end;\r
 846 \r
 847     (*********************************************************)\r
 848 \r
 849     procedure GenerarOrdDec( var arch: text; n: integer; reabrir: boolean );\r
 850 \r
 851        begin\r
 852             if reabrir then rewrite( arch );\r
 853             GetInvOrdApellidos( arch, n );\r
 854             if reabrir then close( arch );\r
 855        end;\r
 856 \r
 857     (*********************************************************)\r
 858 \r
 859     procedure Generar90Ord( var arch: text );\r
 860 \r
 861        begin\r
 862             rewrite( arch );\r
 863             GenerarOrd( arch, 900, false );\r
 864             GenerarRND( arch, 100, false );\r
 865             close( arch );\r
 866        end;\r
 867 \r
 868     (*********************************************************)\r
 869 \r
 870     procedure Generar90OrdDec( var arch: text );\r
 871 \r
 872        begin\r
 873             rewrite( arch );\r
 874             GenerarOrdDec( arch, 900, false );\r
 875             GenerarRND( arch, 100, false );\r
 876             close( arch );\r
 877        end;\r
 878 \r
 879     (*********************************************************)\r
 880 \r
 881     var { procedure MenuGenerar }\r
 882        tecla: char;\r
 883 \r
 884     begin\r
 885          clrscr;\r
 886          textcolor( Yellow );\r
 887          gotoxy( 19, 3 );\r
 888          writeln( 'COMPARACION DE ALGORITMOS DE ORDENAMIENTO' );\r
 889          gotoxy( 19, 4 );\r
 890          writeln( '~~~~~~~~~~~ ~~ ~~~~~~~~~~ ~~ ~~~~~~~~~~~~' );\r
 891          textcolor( LightCyan );\r
 892          gotoxy( 1, 7 );\r
 893          writeln( '  Generar Archivo (''DATOS.TXT''):' );\r
 894          writeln( '  ------- ------- -------------' );\r
 895          textcolor( LightGray );\r
 896          writeln;\r
 897          writeln;\r
 898          writeln( '     1.- Con datos desordenados.' );\r
 899          writeln( '     2.- Con datos en orden creciente (APELLIDO, DNI).' );\r
 900          writeln( '     3.- Con datos en orden decreciente (APELLIDO, DNI).' );\r
 901          writeln( '     4.- Con 90% datos en orden creciente (APELLIDO, DNI) + 10% desordenado.' );\r
 902          writeln( '     5.- Con 90% datos en orden decreciente (APELLIDO, DNI) + 10% desordenado.' );\r
 903          writeln( '     0.- Men£ Anterior.' );\r
 904          gotoxy( 1, 20 );\r
 905          textcolor( White );\r
 906          write( '  Ingrese su opci¢n: ' );\r
 907          textcolor( Yellow );\r
 908          tecla := readkey;\r
 909          while ( ( tecla < '1' ) or ( tecla > '5' ) ) and ( tecla <> '0' ) do\r
 910            begin\r
 911                 textcolor( White );\r
 912                 gotoxy( 1, 20 );\r
 913                 write( '  Ingrese su opci¢n (1 a 5 o 0): ' );\r
 914                 textcolor( Yellow );\r
 915                 tecla := readkey;\r
 916            end;\r
 917          case tecla of\r
 918             '1': GenerarRND( arch, 1000, true );\r
 919             '2': GenerarOrd( arch, 1000, true );\r
 920             '3': GenerarOrdDec( arch, 1000, true );\r
 921             '4': Generar90Ord( arch );\r
 922             '5': Generar90OrdDec( arch );\r
 923             '0': ;\r
 924          end;\r
 925     end; { procedure MenuGenerar }\r
 926 \r
 927 (*********************************************************)\r
 928 \r
 929 { procedure MenuPrincipal( var arch: text; var datos: TABLA );}\r
 930 \r
 931     var\r
 932        datos: TABLA;\r
 933        arch: text;\r
 934        tecla: char;\r
 935        salir: boolean;\r
 936 \r
 937     begin\r
 938      randomize;\r
 939      assign( arch, 'DATOS.TXT' );\r
 940      salir := false;\r
 941      textbackground( Blue );\r
 942 \r
 943      while not salir do\r
 944        begin\r
 945             clrscr;\r
 946             textcolor( Yellow );\r
 947             gotoxy( 19, 3 );\r
 948             writeln( 'COMPARACION DE ALGORITMOS DE ORDENAMIENTO' );\r
 949             gotoxy( 19, 4 );\r
 950             writeln( '~~~~~~~~~~~ ~~ ~~~~~~~~~~ ~~ ~~~~~~~~~~~~' );\r
 951             gotoxy( 1, 7 );\r
 952             textcolor( LightCyan );\r
 953             writeln( '  Men£ Principal:' );\r
 954             writeln( '  ---- ---------' );\r
 955             textcolor( LightGray );\r
 956             writeln;\r
 957             writeln;\r
 958             writeln( '     1.- Generar Archivo (''DATOS.TXT'').' );\r
 959             writeln( '     2.- Evaluar Algoritmos.' );\r
 960             writeln( '     0.- Salir.' );\r
 961             gotoxy( 1, 20 );\r
 962             textcolor( White );\r
 963             write( '  Ingrese su opci¢n: ' );\r
 964             textcolor( Yellow );\r
 965             tecla := readkey;\r
 966             while ( ( tecla < '1' ) or ( tecla > '2' ) ) and ( tecla <> '0' ) do\r
 967               begin\r
 968                    textcolor( White );\r
 969                    gotoxy( 1, 20 );\r
 970                    write( '  Ingrese su opci¢n (1, 2 o 0): ' );\r
 971                    textcolor( Yellow );\r
 972                    tecla := readkey;\r
 973               end;\r
 974             case tecla of\r
 975                  '1': MenuGenerar( arch );\r
 976                  '2': MenuEvaluar( datos, arch );\r
 977                  '0': salir := true;\r
 978             end;\r
 979        end;\r
 980      writeln;\r
 981      NormVideo;\r
 982      clrscr;\r
 983      writeln;\r
 984      textcolor( white );\r
 985      writeln( ' COMPARACION DE ALGORITMOS DE ORDENAMIENTO versi¢n 1.1.0 <-o-o-> Luca - Soft' );\r
 986      NormVideo;\r
 987      writeln( '  Desarrollado por Leandro Lucarella para la Facultad de Ingenier¡a de la' );\r
 988      writeln( '  Universidad de Buenos Aires. Consultas, sugerencias y/o reprobaciones a:' );\r
 989      writeln;\r
 990      textcolor( LightMagenta );\r
 991      write( '                lluca@cnba.uba.ar' );\r
 992      NormVideo;\r
 993      write( '   o   ' );\r
 994      textcolor( LightMagenta );\r
 995      writeln( 'lluca@geocities.com' );\r
 996      NormVideo;\r
 997      writeln;\r
 998      writeln( '  (c) 1999 - Todos los derechos reservados.' );\r
 999      delay( 750 );\r
1000 \r
1001      {close( arch );}\r
1002   end.