X-Git-Url: https://git.llucax.com/z.facultad/75.40/1er-cuat/orden.git/blobdiff_plain/0de676ba756234e786a5d42e8bf894078d34af96..HEAD:/src/comp.pas diff --git a/src/comp.pas b/src/comp.pas index e69bd46..887e92d 100644 --- a/src/comp.pas +++ b/src/comp.pas @@ -1,1667 +1,1667 @@ -program Comparacion_De_Algoritmos_De_Ordenamiento; - -uses - CRT, DOS; - -const - MAX_APE = 15; - RETARDO = 50; - VERSION = '1.2.8'; - -type - APELLIDO = string[MAX_APE]; - DOCUMENTO = longint; - PERSONA = record - ap: APELLIDO; - dni: DOCUMENTO; - end; - TABLA = array[1..1000] of PERSONA; - -(*********************************************************) - - procedure CargarArchivo( var datos: TABLA; var ar: text; tam: integer ); - - var - i: integer; - - begin - for i:= 1 to tam do - begin - writeln( ar, datos[i].ap ); - writeln( ar, datos[i].dni ); - writeln( ar ); - end; - end; { procedure CargarArchivo } - -(*********************************************************) - - procedure Retardar( centenas: longint ); - - var - i: integer; - - begin - for i:= 1 to centenas * 100 do ; - end; { procedure Retardar } - -(*********************************************************) -(*********************************************************) - - procedure MenuEvaluar( var datos: TABLA; var arch: text ); - - type - HORA = record - h, - m, - s, - c: longint; - end; - ORDEN = ( CRECIENTE, DECRECIENTE ); - MEDICION = record - Comp, - Int, - Tiem: longint; - end; - var - bs, bsm, shs, rs, ss, is, sls, slsm, qs: MEDICION; - - (*********************************************************) - - procedure CrearInforme( ord: ORDEN ); - - (*********************************************************) - - procedure InfMetodo( var info: text; metodo: string; sort: MEDICION ); - - begin - writeln( info ); - writeln( info, metodo, ':' ); - writeln( info, ' Comparaciones: ', sort.Comp: 1 ); - writeln( info, ' Intercambios: ', sort.Int div 3: 1, ' (', sort.Int: 1, ' asignaciones)' ); - writeln( info, ' Tiempo (seg): ', sort.Tiem / 100: 2: 2 ); - end; { procedure InfMetodo } - - (*********************************************************) - - var { procedure CrearInforme } - info: text; - - begin - assign( info, 'INFORME.TXT' ); - rewrite( info ); - writeln( info ); - if ord = DECRECIENTE then - begin - writeln( info, 'INFORME: Orden Decreciente.' ); - writeln( info, '======= ~~~~~ ~~~~~~~~~~~' ); - end - else - begin - writeln( info, 'INFORME: Orden Creciente.' ); - writeln( info, '======= ~~~~~ ~~~~~~~~~' ); - end; - writeln( info ); - InfMetodo( info, 'Bubble Sort', bs ); - InfMetodo( info, 'Bubble Sort Mejorado', bsm ); - InfMetodo( info, 'Shake Sort', shs ); - InfMetodo( info, 'Ripple Sort', rs ); - InfMetodo( info, 'Selection Sort', ss ); - InfMetodo( info, 'Insertion Sort', is ); - InfMetodo( info, 'Shell''s Sort', sls ); - InfMetodo( info, 'Shell''s Sort Mejorado', slsm ); - InfMetodo( info, 'Quick Sort', qs ); - writeln( info ); - writeln( info ); - writeln( info, 'NOTA: La cantidad de intercambios medida se tom¢ a partir de la cantidad de' ); - writeln( info, '==== asignaciones, ya que en el Insertion Sort no hay intercambios. De esta' ); - writeln( info, ' manera, un intercambio equivales a 3 asignaciones.' ); - close( info ); - end; { procedure CrearInforme } - - (*********************************************************) - - procedure NoExisteArch; - - begin - clrscr; - gotoxy( 20, 10 ); - textcolor( LightMagenta + Blink ); - writeln( 'ERROR: No existe el archivo a evaluar!' ); - textcolor( LightGray ); - writeln; - writeln( ' Creelo seleccionando la opci¢n 1 del Men£ Principal.' ); - delay( 4000 ); - end; { procedure NoExisteArch } - - (*********************************************************) - - function ExisteArchivo( nombre: String ): boolean; - - { funcion extrida de la ayuda del Turbo Pascal 7 } - - var - arch: text; - - begin - {$I-} - Assign( arch, nombre ); - FileMode := 0; { Solo lectura } - Reset( arch ); - Close( arch ); - {$I+} - ExisteArchivo := (IOResult = 0) and (nombre <> ''); - end; { function ExisteArchivo } - - (*********************************************************) - - procedure CargarTabla( var ar: text; var datos: TABLA; tam: integer ); - - var - i: integer; - void: string[2]; - - begin - for i:= 1 to tam do - begin - readln( ar, datos[i].ap ); - readln( ar, datos[i].dni ); - readln( ar, void ); - end; - end; { procedure CargarTabla } - - (*********************************************************) - - procedure Intercambiar( var a, b: PERSONA; var int: longint ); - - var - aux: PERSONA; - - begin - int := int + 1; - Retardar( RETARDO ); - aux := a; - int := int + 1; - Retardar( RETARDO ); - a := b; - int := int + 1; - Retardar( RETARDO ); - b := aux; - end; { procedure Intercambiar } - - (*********************************************************) - - procedure GetHora( var hor: HORA ); - - var - h, m, s, c: word; - - begin - gettime( h, m, s, c ); - hor.h := h; - hor.m := m; - hor.s := s; - hor.c := c; - end; { procedure GetHora } - - (*********************************************************) - - function GetTiempo( h1, h2: HORA ): longint; - - var - t: longint; - aux: HORA; - - begin - if h1.h <> h2.h then { pone al menor como h2 y al mayor como h1 } - begin - if h1.h < h2.h then - begin - aux := h1; - h1 := h2; - h2 := aux; - end - end - else if h1.m <> h2.m then - begin - if h1.m < h2.m then - begin - aux := h1; - h1 := h2; - h2 := aux; - end - end - else if h1.s <> h2.s then - begin - if h1.s < h2.s then - begin - aux := h1; - h1 := h2; - h2 := aux; - end - end - else if h1.c <> h2.c then - if h1.c < h2.c then - begin - aux := h1; - h1 := h2; - h2 := aux; - end; - t := ( ( ( h1.h - h2.h ) * 60 + ( h1.m - h2.m ) ) * 60 + ( h1.s - h2.s ) ) * 100 + ( h1.c - h2.c ); - GetTiempo := t; - end; { function GetTiempo } - - (*********************************************************) - - procedure EvaluarCre( var datos: TABLA; var arch: text ); - - (*********************************************************) - - procedure BubbleSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); - - var - i, j: integer; - h1, h2: HORA; - - begin - GetHora( h1 ); - m.Comp := 0; - m.Int := 0; - reset( arch ); - CargarTabla( arch, datos, 1000 ); - close( arch ); - for i := tam - 1 downto 1 do - begin - for j := tam - 1 downto 1 do - begin - m.Comp := m.Comp + 1; - Retardar( RETARDO ); - if datos[j].ap > datos[j+1].ap then - Intercambiar( datos[j], datos[j+1], m.Int); - end; - end; - GetHora( h2 ); - m.Tiem := GetTiempo( h1, h2 ); - end; { procedure BubbleSort } - - (*********************************************************) - - procedure BubbleSortMej( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); - - var - huboint: boolean; - i, n: integer; - h1, h2: HORA; - - begin - GetHora( h1 ); - m.Comp := 0; - m.Int := 0; - n := 1; - reset( arch ); - CargarTabla( arch, datos, 1000 ); - close( arch ); - huboint := true; - while huboint do - begin - huboint := false; - for i := tam - 1 downto n do - begin - m.Comp := m.Comp + 1; - Retardar( RETARDO ); - if datos[i].ap > datos[i+1].ap then - begin - Intercambiar( datos[i], datos[i+1], m.Int); - huboint := true; - end; - end; - n := n + 1; - end; - GetHora( h2 ); - m.Tiem := GetTiempo( h1, h2 ); - end; { procedure BubbleSortMej } - - (*********************************************************) - - procedure ShakeSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); - var - h1, h2: HORA; - i, d, j, tmp: integer; - - begin - GetHora( h1 ); - m.Comp := 0; - m.Int := 0; - reset( arch ); - CargarTabla( arch, datos, 1000 ); - close( arch ); - i := 2; - d := tam; - tmp := tam; - repeat - for j := d downto i do - begin - m.Comp := m.Comp + 1; - Retardar( RETARDO ); - if datos[j].ap < datos[j-1].ap then - begin - Intercambiar( datos[j], datos[j-1], m.Int ); - tmp := j; - end; - end; - i := tmp + 1; - for j := i to d do - begin - m.Comp := m.Comp + 1; - Retardar( RETARDO ); - if datos[j].ap < datos[j-1].ap then - begin - Intercambiar( datos[j], datos[j-1], m.Int ); - tmp := j; - end; - end; - d := tmp - 1; - until i >= d; - GetHora( h2 ); - m.Tiem := GetTiempo( h1, h2 ); - end; { procedure ShakeSort } - - (*********************************************************) - - procedure RippleSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); - var - h1, h2: HORA; - i, j: integer; - - begin - GetHora( h1 ); - m.Comp := 0; - m.Int := 0; - reset( arch ); - CargarTabla( arch, datos, 1000 ); - close( arch ); - for i := 1 to tam do - begin - for j := i + 1 to tam do - begin - m.Comp := m.Comp + 1; - Retardar( RETARDO ); - if datos[i].ap > datos[j].ap then Intercambiar( datos[i], datos[j], m.Int ); - end; - end; - GetHora( h2 ); - m.Tiem := GetTiempo( h1, h2 ); - end; { procedure RippleSort } - - (*********************************************************) - - procedure SelectionSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); - var - i, sel, n: integer; - hubosel: boolean; - h1, h2: HORA; - - begin - GetHora( h1 ); - m.Comp := 0; - m.Int := 0; - reset( arch ); - CargarTabla( arch, datos, 1000 ); - close( arch ); - for n := 1 to tam - 1 do - begin - hubosel := false; - sel := n; - for i := n + 1 to tam do - begin - m.Comp := m.Comp + 1; - Retardar( RETARDO ); - if datos[sel].ap > datos[i].ap then - begin - sel := i; - hubosel := true; - end; - end; - if hubosel then Intercambiar( datos[n], datos[sel], m.Int); - end; - GetHora( h2 ); - m.Tiem := GetTiempo( h1, h2 ); - end; { procedure SelectionSort } - - (*********************************************************) - - procedure InsertionSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); - var - h1, h2: HORA; - i, j, k: integer; - tmp: PERSONA; - terminar: boolean; - - begin - GetHora( h1 ); - m.Comp := 0; - m.Int := 0; - reset( arch ); - CargarTabla( arch, datos, 1000 ); - close( arch ); - for i := 2 to tam do - begin - m.Int := m.Int + 1; - Retardar( RETARDO ); - tmp := datos[i]; - j := i - 1; - terminar := false; - while ( j >= 1 ) and ( not terminar ) do - begin - m.Comp := m.Comp + 1; - Retardar( RETARDO ); - if ( tmp.ap < datos[j].ap ) then - begin - m.Int := m.Int + 1; - Retardar( RETARDO ); - datos[j+1] := datos[j]; - j := j - 1; - end - else terminar := true; - end; - m.Int := m.Int + 1; - Retardar( RETARDO ); - datos[j+1] := tmp; - end; - GetHora( h2 ); - m.Tiem := GetTiempo( h1, h2 ); - end; { procedure InsertionSort } - - (*********************************************************) - - procedure ShellSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); - var - h1, h2: HORA; - hueco, i, j: integer; - huboint: boolean; - - begin - GetHora( h1 ); - m.Comp := 0; - m.Int := 0; - reset( arch ); - CargarTabla( arch, datos, 1000 ); - close( arch ); - hueco := tam; - while hueco > 1 do - begin - hueco := hueco div 2; - huboint := true; - while huboint do - begin - huboint := false; - for i := 1 to tam - hueco do - begin - j := i + hueco; - m.Comp := m.Comp + 1; - Retardar( RETARDO ); - if ( datos[i].ap > datos[j].ap ) then - begin - Intercambiar( datos[i], datos[j], m.Int ); - huboint := true; - end; - end; - end; - end; - GetHora( h2 ); - m.Tiem := GetTiempo( h1, h2 ); - end; { procedure ShellSort } - - (*********************************************************) - - procedure ShellSortMej( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); - - (*********************************************************) - - procedure Shell( var datos: TABLA; hueco, i: integer; var comp, int: longint ); - var - j: integer; - - begin - j := i + hueco; - comp := comp + 1; - Retardar( RETARDO ); - if ( datos[i].ap > datos[j].ap ) then - begin - Intercambiar( datos[i], datos[j], int ); - if (i - hueco) > 0 then - Shell( datos, hueco, i - hueco, comp, int ); - end; - end; { procedure Shell } - - (*********************************************************) - - var { procedure ShellSortMej } - h1, h2: HORA; - hueco, i, j: integer; - - begin - GetHora( h1 ); - m.Comp := 0; - m.Int := 0; - reset( arch ); - CargarTabla( arch, datos, 1000 ); - close( arch ); - hueco := tam; - while hueco > 1 do - begin - hueco := hueco div 2; - for i := 1 to tam - hueco do - begin - j := i + hueco; - m.Comp := m.Comp + 1; - Retardar( RETARDO ); - if ( datos[i].ap > datos[j].ap ) then - begin - Intercambiar( datos[i], datos[j], m.Int ); - if (i - hueco) > 0 then - Shell( datos, hueco, i - hueco, m.Comp, m.Int ); - end; - end; - end; - GetHora( h2 ); - m.Tiem := GetTiempo( h1, h2 ); - end; { procedure ShellSortMej } - - (*********************************************************) - - procedure QuickSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); - - (*********************************************************) - - procedure QSort( var datos: TABLA; min, max: integer; var comp, int: longint ); - - var - i, j: integer; - sel: PERSONA; - flag: boolean; - - begin - sel := datos[( min + max ) div 2]; - i := min; - j := max; - repeat - comp := comp + 1; - Retardar( RETARDO ); - flag := false; - while datos[i].ap < sel.ap do - begin - if flag then begin - comp := comp + 1; - Retardar( RETARDO ); - end - else flag := true; - i := i + 1; - end; - comp := comp + 1; - Retardar( RETARDO ); - flag := false; - while datos[j].ap > sel.ap do - begin - if flag then begin - comp := comp + 1; - Retardar( RETARDO ); - end - else flag := true; - j := j - 1; - end; - if i <= j then - begin - if i < j then Intercambiar( datos[i], datos[j], int ); - i := i + 1; - j := j - 1; - end; - until i > j; - if min < j then QSort( datos, min, j, comp, int); - if i < max then QSort( datos, i, max, comp, int); - end; { procedure QSort } - - (*********************************************************) - - var - h1, h2: HORA; - - begin { procedure QuickSort } - GetHora( h1 ); - m.Comp := 0; - m.Int := 0; - reset( arch ); - CargarTabla( arch, datos, 1000 ); - close( arch ); - QSort( datos, 1, 1000, m.Comp, m.Int ); - GetHora( h2 ); - m.Tiem := GetTiempo( h1, h2 ); - end; { procedure QuickSort } - - (*********************************************************) - - begin { procedure EvaluarCre } - if ExisteArchivo( 'DATOS.TXT' ) then - begin - BubbleSort( arch, datos, 1000, bs ); - BubbleSortMej( arch, datos, 1000, bsm ); - ShakeSort( arch, datos, 1000, shs ); - RippleSort( arch, datos, 1000, rs ); - SelectionSort( arch, datos, 1000, ss ); - InsertionSort( arch, datos, 1000, is ); - ShellSort( arch, datos, 1000, sls ); - ShellSortMej( arch, datos, 1000, slsm ); - QuickSort( arch, datos, 1000, qs ); - CrearInforme( CRECIENTE ); - end - else - NoExisteArch; - end; { procedure EvaluarCre } - - (*********************************************************) - - procedure EvaluarDec( var datos: TABLA; var arch: text ); - - (*********************************************************) - - procedure BubbleSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); - - var - i, j: integer; - h1, h2: HORA; - - begin - GetHora( h1 ); - m.Comp := 0; - m.Int := 0; - reset( arch ); - CargarTabla( arch, datos, 1000 ); - close( arch ); - for i := tam - 1 downto 1 do - begin - for j := tam - 1 downto 1 do - begin - m.Comp := m.Comp + 1; - Retardar( RETARDO ); - if datos[j].ap < datos[j+1].ap then - Intercambiar( datos[j], datos[j+1], m.Int); - end; - end; - GetHora( h2 ); - m.Tiem := GetTiempo( h1, h2 ); - end; { procedure BubbleSort } - - (*********************************************************) - - procedure BubbleSortMej( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); - - var - huboint: boolean; - i, n: integer; - h1, h2: HORA; - - begin - GetHora( h1 ); - m.Comp := 0; - m.Int := 0; - n := 1; - reset( arch ); - CargarTabla( arch, datos, 1000 ); - close( arch ); - huboint := true; - while huboint do - begin - huboint := false; - for i := tam - 1 downto n do - begin - m.Comp := m.Comp + 1; - Retardar( RETARDO ); - if datos[i].ap < datos[i+1].ap then - begin - Intercambiar( datos[i], datos[i+1], m.Int); - huboint := true; - end; - end; - n := n + 1; - end; - GetHora( h2 ); - m.Tiem := GetTiempo( h1, h2 ); - end; { procedure BubbleSortMej } - - (*********************************************************) - - procedure ShakeSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); - var - h1, h2: HORA; - i, d, j, tmp: integer; - - begin - GetHora( h1 ); - m.Comp := 0; - m.Int := 0; - reset( arch ); - CargarTabla( arch, datos, 1000 ); - close( arch ); - i := 2; - d := tam; - tmp := tam; - repeat - for j := d downto i do - begin - m.Comp := m.Comp + 1; - Retardar( RETARDO ); - if datos[j].ap > datos[j-1].ap then - begin - Intercambiar( datos[j], datos[j-1], m.Int ); - tmp := j; - end; - end; - i := tmp + 1; - for j := i to d do - begin - m.Comp := m.Comp + 1; - Retardar( RETARDO ); - if datos[j].ap > datos[j-1].ap then - begin - Intercambiar( datos[j], datos[j-1], m.Int ); - tmp := j; - end; - end; - d := tmp - 1; - until i >= d; - GetHora( h2 ); - m.Tiem := GetTiempo( h1, h2 ); - end; { procedure ShakeSort } - - (*********************************************************) - - procedure RippleSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); - var - h1, h2: HORA; - i, j: integer; - - begin - GetHora( h1 ); - m.Comp := 0; - m.Int := 0; - reset( arch ); - CargarTabla( arch, datos, 1000 ); - close( arch ); - for i := 1 to tam do - begin - for j := i + 1 to tam do - begin - m.Comp := m.Comp + 1; - Retardar( RETARDO ); - if datos[i].ap < datos[j].ap then Intercambiar( datos[i], datos[j], m.Int ); - end; - end; - GetHora( h2 ); - m.Tiem := GetTiempo( h1, h2 ); - end; { procedure RippleSort } - - (*********************************************************) - - procedure SelectionSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); - var - i, sel, n: integer; - hubosel: boolean; - h1, h2: HORA; - - begin - GetHora( h1 ); - m.Comp := 0; - m.Int := 0; - reset( arch ); - CargarTabla( arch, datos, 1000 ); - close( arch ); - for n := 1 to tam - 1 do - begin - hubosel := false; - sel := n; - for i := n + 1 to tam do - begin - m.Comp := m.Comp + 1; - Retardar( RETARDO ); - if datos[sel].ap < datos[i].ap then - begin - sel := i; - hubosel := true; - end; - end; - if hubosel then Intercambiar( datos[n], datos[sel], m.Int); - end; - GetHora( h2 ); - m.Tiem := GetTiempo( h1, h2 ); - end; { procedure SelectionSort } - - (*********************************************************) - - procedure InsertionSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); - var - h1, h2: HORA; - i, j, k: integer; - tmp: PERSONA; - terminar: boolean; - - begin - GetHora( h1 ); - m.Comp := 0; - m.Int := 0; - reset( arch ); - CargarTabla( arch, datos, 1000 ); - close( arch ); - for i := 2 to tam do - begin - m.Int := m.Int + 1; - Retardar( RETARDO ); - tmp := datos[i]; - j := i - 1; - terminar := false; - while ( j >= 1 ) and ( not terminar ) do - begin - m.Comp := m.Comp + 1; - Retardar( RETARDO ); - if ( tmp.ap > datos[j].ap ) then - begin - m.Int := m.Int + 1; - Retardar( RETARDO ); - datos[j+1] := datos[j]; - j := j - 1; - end - else terminar := true; - end; - m.Int := m.Int + 1; - Retardar( RETARDO ); - datos[j+1] := tmp; - end; - GetHora( h2 ); - m.Tiem := GetTiempo( h1, h2 ); - end; { procedure InsertionSort } - - (*********************************************************) - - procedure ShellSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); - var - h1, h2: HORA; - hueco, i, j: integer; - huboint: boolean; - - begin - GetHora( h1 ); - m.Comp := 0; - m.Int := 0; - reset( arch ); - CargarTabla( arch, datos, 1000 ); - close( arch ); - hueco := tam; - while hueco > 1 do - begin - hueco := hueco div 2; - huboint := true; - while huboint do - begin - huboint := false; - for i := 1 to tam - hueco do - begin - j := i + hueco; - m.Comp := m.Comp + 1; - Retardar( RETARDO ); - if ( datos[i].ap < datos[j].ap ) then - begin - Intercambiar( datos[i], datos[j], m.Int ); - huboint := true; - end; - end; - end; - end; - GetHora( h2 ); - m.Tiem := GetTiempo( h1, h2 ); - end; { procedure ShellSort } - - (*********************************************************) - - procedure ShellSortMej( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); - - (*********************************************************) - - procedure Shell( var datos: TABLA; hueco, i: integer; - var comp: longint; var int: longint ); - var - j: integer; - - begin - j := i + hueco; - comp := comp + 1; - Retardar( RETARDO ); - if ( datos[i].ap < datos[j].ap ) then - begin - Intercambiar( datos[i], datos[j], int ); - if (i - hueco) > 0 then - Shell( datos, hueco, i - hueco, comp, int ); - end; - end; { procedure Shell } - - (*********************************************************) - - var { procedure ShellSortMej } - h1, h2: HORA; - hueco, i, j: integer; - - begin - GetHora( h1 ); - m.Comp := 0; - m.Int := 0; - reset( arch ); - CargarTabla( arch, datos, 1000 ); - close( arch ); - hueco := tam; - while hueco > 1 do - begin - hueco := hueco div 2; - for i := 1 to tam - hueco do - begin - j := i + hueco; - m.Comp := m.Comp + 1; - Retardar( RETARDO ); - if ( datos[i].ap < datos[j].ap ) then - begin - Intercambiar( datos[i], datos[j], m.Int ); - if (i - hueco) > 0 then - Shell( datos, hueco, i - hueco, m.Comp, m.Int ); - end; - end; - end; - GetHora( h2 ); - m.Tiem := GetTiempo( h1, h2 ); - end; { procedure ShellSortMej } - - (*********************************************************) - - procedure QuickSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); - - procedure QSort( var datos: TABLA; min, max: integer; - var comp: longint; var int: longint ); - - var - i, j: integer; - sel: PERSONA; - flag: boolean; - - begin - sel := datos[( min + max ) div 2]; - i := min; - j := max; - repeat - comp := comp + 1; - Retardar( RETARDO ); - flag := false; - while datos[i].ap > sel.ap do - begin - if flag then begin - comp := comp + 1; - Retardar( RETARDO ); - end - else flag := true; - i := i + 1; - end; - comp := comp + 1; - Retardar( RETARDO ); - flag := false; - while datos[j].ap < sel.ap do - begin - if flag then begin - comp := comp + 1; - Retardar( RETARDO ); - end - else flag := true; - j := j - 1; - end; - if i <= j then - begin - if i < j then Intercambiar( datos[i], datos[j], int ); - i := i + 1; - j := j - 1; - end; - until i > j; - if min < j then QSort( datos, min, j, comp, int); - if i < max then QSort( datos, i, max, comp, int); - end; { procedure QSort } - - (*********************************************************) - - var - h1, h2: HORA; - - begin { procedure QuickSort } - GetHora( h1 ); - m.Comp := 0; - m.Int := 0; - reset( arch ); - CargarTabla( arch, datos, 1000 ); - close( arch ); - QSort( datos, 1, 1000, m.Comp, m.Int ); - GetHora( h2 ); - m.Tiem := GetTiempo( h1, h2 ); - end; { procedure QuickSort } - - (*********************************************************) - - begin { procedure EvaluarDec } - if ExisteArchivo( 'DATOS.TXT' ) then - begin - BubbleSort( arch, datos, 1000, bs ); - BubbleSortMej( arch, datos, 1000, bsm ); - ShakeSort( arch, datos, 1000, shs ); - RippleSort( arch, datos, 1000, rs ); - SelectionSort( arch, datos, 1000, ss ); - InsertionSort( arch, datos, 1000, is ); - ShellSort( arch, datos, 1000, sls ); - ShellSortMej( arch, datos, 1000, slsm ); - QuickSort( arch, datos, 1000, qs ); - CrearInforme( DECRECIENTE ); - end - else - NoExisteArch; - end; { procedure EvaluarDec } - - (*********************************************************) - - var { procedure MenuEvaluar } - tecla: char; - - begin - clrscr; - textcolor( Yellow ); - gotoxy( 19, 3 ); - writeln( 'COMPARACION DE ALGORITMOS DE ORDENAMIENTO' ); - gotoxy( 19, 4 ); - writeln( '~~~~~~~~~~~ ~~ ~~~~~~~~~~ ~~ ~~~~~~~~~~~~' ); - textcolor( LightCyan ); - gotoxy( 1, 7 ); - writeln( ' Evaluar Algoritmos:' ); - writeln( ' ------- ----------' ); - textcolor( LightGray ); - writeln; - writeln; - writeln( ' 1.- Ordenando en forma creciente.' ); - writeln( ' 2.- Ordenando en forma decreciente.' ); - writeln( ' 0.- Men£ Anterior.' ); - gotoxy( 1, 20 ); - textcolor( White ); - write( ' Ingrese su opci¢n: ' ); - textcolor( Yellow ); - tecla := readkey; - while ( ( tecla < '1' ) or ( tecla > '2' ) ) and ( tecla <> '0' ) do - begin - textcolor( White ); - gotoxy( 1, 20 ); - write( ' Ingrese su opci¢n (1, 2 o 0): ' ); - textcolor( Yellow ); - tecla := readkey; - end; - case tecla of - '1': if ExisteArchivo( 'DATOS.TXT' ) then EvaluarCre( datos, arch ) - else NoExisteArch; - '2': if ExisteArchivo( 'DATOS.TXT' ) then EvaluarDec( datos, arch ) - else NoExisteArch; - '0': ; - end; - end; - -(*********************************************************) -(*********************************************************) - - procedure MenuGenerar( var arch: text ); - - type - TIPO_LETRA = ( TL_VOCAL, TL_CONSO ); - TIPO_VOCAL = ( TV_AEIOU, TV_EI ); - 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 ); - - (*********************************************************) - - function GetRNDApellido( max, min: integer ): APELLIDO; - - (*********************************************************) - - function GetVocal( tipo: TIPO_VOCAL ): char; - - var - valor: integer; - - begin - if tipo = TV_AEIOU then valor := random( 16 ) - else valor := random( 6 ) + 5; - case valor of - 0..4: GetVocal := 'A'; - 5..7: GetVocal := 'E'; - 8..10: GetVocal := 'I'; - 11..13: GetVocal := 'O'; - 14..15: GetVocal := 'U'; - end; - end; { function GetVocal } - - (*********************************************************) - - procedure GetRNDVocal( var indic: INDICADOR; var proxl: TIPO_LETRA; var vocal: char ); - - var - valor: integer; - - begin - case indic of - I_ESQ: - begin - vocal := 'U'; - indic := I_ESQU; - proxl := TL_VOCAL; - end; - I_ESQU: - begin - vocal := GetVocal( TV_EI ); - indic := I_NADA; - proxl := TL_CONSO; - end; - else - begin - vocal := GetVocal( TV_AEIOU ); - indic := I_NADA; - if random( 40 ) = 0 then proxl := TL_VOCAL - else proxl := TL_CONSO; - end; - end; - end; { procedure GetRNDVocal } - - (*********************************************************) - - procedure GetRNDConsonante( var indic: INDICADOR; var proxl: TIPO_LETRA; var conso: char ); - - var - valor: integer; - - begin - proxl := TL_VOCAL; - indic := I_NADA; - - case indic of - I_ESF, I_ESR, I_ESG, I_EST: conso := 'R'; - I_ESB: case random( 2 ) of - 0: conso := 'R'; - 1: conso := 'L'; - end; - I_ESC: case random( 4 ) of - 0: conso := 'C'; - 1: conso := 'H'; - 2: conso := 'R'; - 3: conso := 'L'; - end; - I_ESL: case random( 6 ) of - 0: conso := 'T'; - 1..5: conso := 'L'; - end; - I_ESM: case random( 3 ) of - 0: conso := 'P'; - 1: conso := 'B'; - 2: conso := 'L'; - end; - I_ESN: case random( 3 ) of - 0: conso := 'R'; - 1: conso := 'V'; - 2: conso := 'C'; - end; - else case random( 55 ) of - 0..3: begin - conso := 'B'; - if random( 10 ) = 0 then begin - indic := I_ESB; - proxl := TL_CONSO; - end; - end; - 4..7: begin - conso := 'C'; - if random( 5 ) = 0 then begin - indic := I_ESC; - proxl := TL_CONSO; - end; - end; - 8..11: conso := 'D'; - 12..14: begin - conso := 'F'; - if random( 10 ) = 0 then begin - indic := I_ESF; - proxl := TL_CONSO; - end; - end; - 15..17: begin - conso := 'G'; - if random( 5 ) = 0 then - begin - indic := I_ESG; - if random( 4 ) = 0 then proxl := TL_CONSO; - end; - end; - 18..19: conso := 'H'; - 20..22: conso := 'J'; - 23..24: conso := 'K'; - 25..27: begin - conso := 'L'; - if random( 15 ) = 0 then - begin - indic := I_ESL; - proxl := TL_CONSO; - end; - end; - 28..30: begin - conso := 'M'; - if random( 5 ) = 0 then - begin - indic := I_ESM; - proxl := TL_CONSO; - end; - end; - 31..33: begin - conso := 'N'; - if random( 5 ) = 0 then - begin - indic := I_ESN; - proxl := TL_CONSO; - end; - end; - 34..36: conso := 'P'; - 37..38: begin - conso := 'Q'; - indic := I_ESQ; - end; - 39..41: begin - conso := 'R'; - if random( 3 ) = 0 then - begin - indic := I_ESR; - proxl := TL_CONSO; - end; - end; - 42..44: conso := 'S'; - 45..47: begin - conso := 'T'; - if random( 10 ) = 0 then - begin - indic := I_EST; - proxl := TL_CONSO; - end; - end; - 48..50: conso := 'V'; - 51: conso := 'W'; - 52: conso := 'X'; - 53: conso := 'Y'; - 54: conso := 'Z'; - end; { case random( 55 ) of } - - end; { case indic of } - end; { procedure GetRNDConsonante } - - (*********************************************************) - - var { function GetRNDApellido } - tam, i: integer; - aux: char; - apel: APELLIDO; - indic: INDICADOR; - proxl: TIPO_LETRA; - - begin - if max > MAX_APE then max := MAX_APE; - tam := random( max + 1 ) + min; - indic := I_NADA; - apel := ''; - if random( 5 ) = 0 then proxl := TL_VOCAL - else proxl := TL_CONSO; - for i := 1 to tam do - begin - if proxl = TL_CONSO then GetRNDConsonante( indic, proxl, aux ) - else GetRNDVocal( indic, proxl, aux ); - apel := apel + aux; - end; - GetRNDApellido := apel; - end; { function GetRNDApellido } - - (*********************************************************) - - function GetRNDLetra( min, max: char ): char; - - begin - GetRNDLetra := chr( random( ord( max ) - ord( min ) + 1 ) + ord( min ) ); - end; - - (*********************************************************) - - procedure GetOrdApellidos( var ar: text; cant: integer ); - - var - mil: boolean; - letra, letra1: char; - i, j, veces: integer; - dni: DOCUMENTO; - ap, ape, apel: APELLIDO; - - begin - mil := false; - if cant = 1000 then mil := true; - dni := 10000000 + (random( 15000 ) * 100); - ap := ''; - ape := ''; - apel := ''; - for letra := 'A' to 'Z' do - begin - ap := letra; - for letra1 := 'A' to 'Z' do - begin - if mil then - case letra of - 'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T': - case letra1 of - 'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T', 'Z': veces := 2; - else veces := 1; - end; - else case letra1 of - 'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T': veces := 2; - else veces := 1; - end; - end - else - case letra of - 'A', 'B', 'C', 'D', 'E', 'F', 'I', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T', 'V': - case letra1 of - 'D', 'F', 'G', 'H', 'I', 'J', 'K', 'U', 'V': veces := 2; - else veces := 1; - end; - else case letra1 of - 'D', 'F', 'G', 'H', 'I', 'J', 'K', 'U': veces := 2; - else veces := 1; - end; - end; - ape := ap + letra1; - for j := 1 to veces do - begin - if j = 1 then apel := ape + GetRNDLetra( 'A', 'M' ) + GetRNDApellido( 6, 1 ) - else apel := ape + GetRNDLetra( 'N', 'Z' ) + GetRNDApellido( 6, 1 ); - dni := dni + random( 50000 ) + 1; - writeln( ar, apel ); - writeln( ar, dni ); - writeln( ar ); - apel := ''; - end; - - ape := ''; - - end; { for letra1 := 'A' to 'Z' do } - - ap := ''; - - end; { for letra := 'A' to 'Z' do } - - end; { procedure GetOrdApellidos } - - (*********************************************************) - - procedure GetInvOrdApellidos( var ar: text; cant: integer ); - - var - mil: boolean; - letra, letra1: char; - i, j, veces: integer; - dni: DOCUMENTO; - ap, ape, apel: APELLIDO; - - begin - mil := false; - if cant = 1000 then mil := true; - dni := 34000000 + (random( 15000 ) * 100); - ap := ''; - ape := ''; - apel := ''; - for letra := 'Z' downto 'A' do - begin - ap := letra; - for letra1 := 'Z' downto 'A' do - begin - if mil then - case letra of - 'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T': - case letra1 of - 'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T', 'Z': veces := 2; - else veces := 1; - end; - else case letra1 of - 'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T': veces := 2; - else veces := 1; - end; - end - else - case letra of - 'A', 'B', 'C', 'D', 'E', 'F', 'I', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T', 'V': - case letra1 of - 'D', 'F', 'G', 'H', 'I', 'J', 'K', 'U', 'V': veces := 2; - else veces := 1; - end; - else case letra1 of - 'D', 'F', 'G', 'H', 'I', 'J', 'K', 'U': veces := 2; - else veces := 1; - end; - end; - ape := ap + letra1; - for j := 1 to veces do - begin - if j <> 1 then apel := ape + GetRNDLetra( 'A', 'M' ) + GetRNDApellido( 6, 1 ) - else apel := ape + GetRNDLetra( 'N', 'Z' ) + GetRNDApellido( 6, 1 ); - dni := dni - random( 40000 ) - 1; - writeln( ar, apel ); - writeln( ar, dni ); - writeln( ar ); - apel := ''; - end; - - ape := ''; - - end; { for letra1 := 'A' to 'Z' do } - - ap := ''; - - end; { for letra := 'A' to 'Z' do } - - end; { GetInvOrdApellidos } - - - (*********************************************************) - - procedure GenerarRND( var arch: text; n: integer; reabrir: boolean ); - - var - i: integer; - ap: APELLIDO; - dni: DOCUMENTO; - - begin - if reabrir then rewrite( arch ); - dni := 10000000 + (random( 15000 ) * 100); - - for i := 1 to n do - begin - ap := GetRNDApellido( 8, 4 ); - dni := dni + random( 50000 ) + 1; - writeln( arch, ap ); - writeln( arch, dni ); - writeln( arch ); - end; - if reabrir then close( arch ); - end; { procedure GenerarRND } - - (*********************************************************) - - procedure GenerarOrd( var arch: text; n: integer; reabrir: boolean ); - - begin - if reabrir then rewrite( arch ); - GetOrdApellidos( arch, n ); - if reabrir then close( arch ); - end; - - (*********************************************************) - - procedure GenerarOrdDec( var arch: text; n: integer; reabrir: boolean ); - - begin - if reabrir then rewrite( arch ); - GetInvOrdApellidos( arch, n ); - if reabrir then close( arch ); - end; - - (*********************************************************) - - procedure Generar90Ord( var arch: text ); - - begin - rewrite( arch ); - GenerarOrd( arch, 900, false ); - GenerarRND( arch, 100, false ); - close( arch ); - end; - - (*********************************************************) - - procedure Generar90OrdDec( var arch: text ); - - begin - rewrite( arch ); - GenerarOrdDec( arch, 900, false ); - GenerarRND( arch, 100, false ); - close( arch ); - end; - - (*********************************************************) - - var { procedure MenuGenerar } - tecla: char; - - begin - clrscr; - textcolor( Yellow ); - gotoxy( 19, 3 ); - writeln( 'COMPARACION DE ALGORITMOS DE ORDENAMIENTO' ); - gotoxy( 19, 4 ); - writeln( '~~~~~~~~~~~ ~~ ~~~~~~~~~~ ~~ ~~~~~~~~~~~~' ); - textcolor( LightCyan ); - gotoxy( 1, 7 ); - writeln( ' Generar Archivo (''DATOS.TXT''):' ); - writeln( ' ------- ------- -------------' ); - textcolor( LightGray ); - writeln; - writeln; - writeln( ' 1.- Con datos desordenados.' ); - writeln( ' 2.- Con datos en orden creciente (APELLIDO, DNI).' ); - writeln( ' 3.- Con datos en orden decreciente (APELLIDO, DNI).' ); - writeln( ' 4.- Con 90% datos en orden creciente (APELLIDO, DNI) + 10% desordenado.' ); - writeln( ' 5.- Con 90% datos en orden decreciente (APELLIDO, DNI) + 10% desordenado.' ); - writeln( ' 0.- Men£ Anterior.' ); - gotoxy( 1, 20 ); - textcolor( White ); - write( ' Ingrese su opci¢n: ' ); - textcolor( Yellow ); - tecla := readkey; - while ( ( tecla < '1' ) or ( tecla > '5' ) ) and ( tecla <> '0' ) do - begin - textcolor( White ); - gotoxy( 1, 20 ); - write( ' Ingrese su opci¢n (1 a 5 o 0): ' ); - textcolor( Yellow ); - tecla := readkey; - end; - case tecla of - '1': GenerarRND( arch, 1000, true ); - '2': GenerarOrd( arch, 1000, true ); - '3': GenerarOrdDec( arch, 1000, true ); - '4': Generar90Ord( arch ); - '5': Generar90OrdDec( arch ); - '0': ; - end; - end; { procedure MenuGenerar } - -(*********************************************************) - - procedure PantallaSalida; - - begin - writeln; - NormVideo; - clrscr; - writeln; - textcolor( white ); - writeln( ' COMPARACION DE ALGORITMOS DE ORDENAMIENTO versi¢n ', VERSION, ' <-o-o-> Luca - Soft' ); - NormVideo; - writeln( ' Desarrollado por Leandro Lucarella para la Facultad de Ingenier¡a de la' ); - writeln( ' Universidad de Buenos Aires. Consultas, sugerencias y/o reprobaciones a:' ); - writeln; - textcolor( LightMagenta ); - write( ' lluca@cnba.uba.ar' ); - NormVideo; - write( ' o ' ); - textcolor( LightMagenta ); - writeln( 'lluca@geocities.com' ); - NormVideo; - writeln; - writeln( ' (c) 1999 - Todos los derechos reservados.' ); - delay( 750 ); - end; - -(*********************************************************) - -var { programa } - datos: TABLA; - arch: text; - tecla: char; - salir: boolean; - -begin - randomize; - assign( arch, 'DATOS.TXT' ); - salir := false; - textbackground( Blue ); - - while not salir do - begin - clrscr; - textcolor( Yellow ); - gotoxy( 19, 3 ); - writeln( 'COMPARACION DE ALGORITMOS DE ORDENAMIENTO' ); - gotoxy( 19, 4 ); - writeln( '~~~~~~~~~~~ ~~ ~~~~~~~~~~ ~~ ~~~~~~~~~~~~' ); - gotoxy( 1, 7 ); - textcolor( LightCyan ); - writeln( ' Men£ Principal:' ); - writeln( ' ---- ---------' ); - textcolor( LightGray ); - writeln; - writeln; - writeln( ' 1.- Generar Archivo (''DATOS.TXT'').' ); - writeln( ' 2.- Evaluar Algoritmos.' ); - writeln( ' 0.- Salir.' ); - gotoxy( 1, 20 ); - textcolor( White ); - write( ' Ingrese su opci¢n: ' ); - textcolor( Yellow ); - tecla := readkey; - while ( ( tecla < '1' ) or ( tecla > '2' ) ) and ( tecla <> '0' ) do - begin - textcolor( White ); - gotoxy( 1, 20 ); - write( ' Ingrese su opci¢n (1, 2 o 0): ' ); - textcolor( Yellow ); - tecla := readkey; - end; - case tecla of - '1': MenuGenerar( arch ); - '2': MenuEvaluar( datos, arch ); - '0': salir := true; - end; - end; - PantallaSalida; +program Comparacion_De_Algoritmos_De_Ordenamiento; + +uses + CRT, DOS; + +const + MAX_APE = 15; + RETARDO = 50; + VERSION = '1.2.8'; + +type + APELLIDO = string[MAX_APE]; + DOCUMENTO = longint; + PERSONA = record + ap: APELLIDO; + dni: DOCUMENTO; + end; + TABLA = array[1..1000] of PERSONA; + +(*********************************************************) + + procedure CargarArchivo( var datos: TABLA; var ar: text; tam: integer ); + + var + i: integer; + + begin + for i:= 1 to tam do + begin + writeln( ar, datos[i].ap ); + writeln( ar, datos[i].dni ); + writeln( ar ); + end; + end; { procedure CargarArchivo } + +(*********************************************************) + + procedure Retardar( centenas: longint ); + + var + i: integer; + + begin + for i:= 1 to centenas * 100 do ; + end; { procedure Retardar } + +(*********************************************************) +(*********************************************************) + + procedure MenuEvaluar( var datos: TABLA; var arch: text ); + + type + HORA = record + h, + m, + s, + c: longint; + end; + ORDEN = ( CRECIENTE, DECRECIENTE ); + MEDICION = record + Comp, + Int, + Tiem: longint; + end; + var + bs, bsm, shs, rs, ss, is, sls, slsm, qs: MEDICION; + + (*********************************************************) + + procedure CrearInforme( ord: ORDEN ); + + (*********************************************************) + + procedure InfMetodo( var info: text; metodo: string; sort: MEDICION ); + + begin + writeln( info ); + writeln( info, metodo, ':' ); + writeln( info, ' Comparaciones: ', sort.Comp: 1 ); + writeln( info, ' Intercambios: ', sort.Int div 3: 1, ' (', sort.Int: 1, ' asignaciones)' ); + writeln( info, ' Tiempo (seg): ', sort.Tiem / 100: 2: 2 ); + end; { procedure InfMetodo } + + (*********************************************************) + + var { procedure CrearInforme } + info: text; + + begin + assign( info, 'INFORME.TXT' ); + rewrite( info ); + writeln( info ); + if ord = DECRECIENTE then + begin + writeln( info, 'INFORME: Orden Decreciente.' ); + writeln( info, '======= ~~~~~ ~~~~~~~~~~~' ); + end + else + begin + writeln( info, 'INFORME: Orden Creciente.' ); + writeln( info, '======= ~~~~~ ~~~~~~~~~' ); + end; + writeln( info ); + InfMetodo( info, 'Bubble Sort', bs ); + InfMetodo( info, 'Bubble Sort Mejorado', bsm ); + InfMetodo( info, 'Shake Sort', shs ); + InfMetodo( info, 'Ripple Sort', rs ); + InfMetodo( info, 'Selection Sort', ss ); + InfMetodo( info, 'Insertion Sort', is ); + InfMetodo( info, 'Shell''s Sort', sls ); + InfMetodo( info, 'Shell''s Sort Mejorado', slsm ); + InfMetodo( info, 'Quick Sort', qs ); + writeln( info ); + writeln( info ); + writeln( info, 'NOTA: La cantidad de intercambios medida se tom¢ a partir de la cantidad de' ); + writeln( info, '==== asignaciones, ya que en el Insertion Sort no hay intercambios. De esta' ); + writeln( info, ' manera, un intercambio equivales a 3 asignaciones.' ); + close( info ); + end; { procedure CrearInforme } + + (*********************************************************) + + procedure NoExisteArch; + + begin + clrscr; + gotoxy( 20, 10 ); + textcolor( LightMagenta + Blink ); + writeln( 'ERROR: No existe el archivo a evaluar!' ); + textcolor( LightGray ); + writeln; + writeln( ' Creelo seleccionando la opci¢n 1 del Men£ Principal.' ); + delay( 4000 ); + end; { procedure NoExisteArch } + + (*********************************************************) + + function ExisteArchivo( nombre: String ): boolean; + + { funcion extrida de la ayuda del Turbo Pascal 7 } + + var + arch: text; + + begin + {$I-} + Assign( arch, nombre ); + FileMode := 0; { Solo lectura } + Reset( arch ); + Close( arch ); + {$I+} + ExisteArchivo := (IOResult = 0) and (nombre <> ''); + end; { function ExisteArchivo } + + (*********************************************************) + + procedure CargarTabla( var ar: text; var datos: TABLA; tam: integer ); + + var + i: integer; + void: string[2]; + + begin + for i:= 1 to tam do + begin + readln( ar, datos[i].ap ); + readln( ar, datos[i].dni ); + readln( ar, void ); + end; + end; { procedure CargarTabla } + + (*********************************************************) + + procedure Intercambiar( var a, b: PERSONA; var int: longint ); + + var + aux: PERSONA; + + begin + int := int + 1; + Retardar( RETARDO ); + aux := a; + int := int + 1; + Retardar( RETARDO ); + a := b; + int := int + 1; + Retardar( RETARDO ); + b := aux; + end; { procedure Intercambiar } + + (*********************************************************) + + procedure GetHora( var hor: HORA ); + + var + h, m, s, c: word; + + begin + gettime( h, m, s, c ); + hor.h := h; + hor.m := m; + hor.s := s; + hor.c := c; + end; { procedure GetHora } + + (*********************************************************) + + function GetTiempo( h1, h2: HORA ): longint; + + var + t: longint; + aux: HORA; + + begin + if h1.h <> h2.h then { pone al menor como h2 y al mayor como h1 } + begin + if h1.h < h2.h then + begin + aux := h1; + h1 := h2; + h2 := aux; + end + end + else if h1.m <> h2.m then + begin + if h1.m < h2.m then + begin + aux := h1; + h1 := h2; + h2 := aux; + end + end + else if h1.s <> h2.s then + begin + if h1.s < h2.s then + begin + aux := h1; + h1 := h2; + h2 := aux; + end + end + else if h1.c <> h2.c then + if h1.c < h2.c then + begin + aux := h1; + h1 := h2; + h2 := aux; + end; + t := ( ( ( h1.h - h2.h ) * 60 + ( h1.m - h2.m ) ) * 60 + ( h1.s - h2.s ) ) * 100 + ( h1.c - h2.c ); + GetTiempo := t; + end; { function GetTiempo } + + (*********************************************************) + + procedure EvaluarCre( var datos: TABLA; var arch: text ); + + (*********************************************************) + + procedure BubbleSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); + + var + i, j: integer; + h1, h2: HORA; + + begin + GetHora( h1 ); + m.Comp := 0; + m.Int := 0; + reset( arch ); + CargarTabla( arch, datos, 1000 ); + close( arch ); + for i := tam - 1 downto 1 do + begin + for j := tam - 1 downto 1 do + begin + m.Comp := m.Comp + 1; + Retardar( RETARDO ); + if datos[j].ap > datos[j+1].ap then + Intercambiar( datos[j], datos[j+1], m.Int); + end; + end; + GetHora( h2 ); + m.Tiem := GetTiempo( h1, h2 ); + end; { procedure BubbleSort } + + (*********************************************************) + + procedure BubbleSortMej( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); + + var + huboint: boolean; + i, n: integer; + h1, h2: HORA; + + begin + GetHora( h1 ); + m.Comp := 0; + m.Int := 0; + n := 1; + reset( arch ); + CargarTabla( arch, datos, 1000 ); + close( arch ); + huboint := true; + while huboint do + begin + huboint := false; + for i := tam - 1 downto n do + begin + m.Comp := m.Comp + 1; + Retardar( RETARDO ); + if datos[i].ap > datos[i+1].ap then + begin + Intercambiar( datos[i], datos[i+1], m.Int); + huboint := true; + end; + end; + n := n + 1; + end; + GetHora( h2 ); + m.Tiem := GetTiempo( h1, h2 ); + end; { procedure BubbleSortMej } + + (*********************************************************) + + procedure ShakeSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); + var + h1, h2: HORA; + i, d, j, tmp: integer; + + begin + GetHora( h1 ); + m.Comp := 0; + m.Int := 0; + reset( arch ); + CargarTabla( arch, datos, 1000 ); + close( arch ); + i := 2; + d := tam; + tmp := tam; + repeat + for j := d downto i do + begin + m.Comp := m.Comp + 1; + Retardar( RETARDO ); + if datos[j].ap < datos[j-1].ap then + begin + Intercambiar( datos[j], datos[j-1], m.Int ); + tmp := j; + end; + end; + i := tmp + 1; + for j := i to d do + begin + m.Comp := m.Comp + 1; + Retardar( RETARDO ); + if datos[j].ap < datos[j-1].ap then + begin + Intercambiar( datos[j], datos[j-1], m.Int ); + tmp := j; + end; + end; + d := tmp - 1; + until i >= d; + GetHora( h2 ); + m.Tiem := GetTiempo( h1, h2 ); + end; { procedure ShakeSort } + + (*********************************************************) + + procedure RippleSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); + var + h1, h2: HORA; + i, j: integer; + + begin + GetHora( h1 ); + m.Comp := 0; + m.Int := 0; + reset( arch ); + CargarTabla( arch, datos, 1000 ); + close( arch ); + for i := 1 to tam do + begin + for j := i + 1 to tam do + begin + m.Comp := m.Comp + 1; + Retardar( RETARDO ); + if datos[i].ap > datos[j].ap then Intercambiar( datos[i], datos[j], m.Int ); + end; + end; + GetHora( h2 ); + m.Tiem := GetTiempo( h1, h2 ); + end; { procedure RippleSort } + + (*********************************************************) + + procedure SelectionSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); + var + i, sel, n: integer; + hubosel: boolean; + h1, h2: HORA; + + begin + GetHora( h1 ); + m.Comp := 0; + m.Int := 0; + reset( arch ); + CargarTabla( arch, datos, 1000 ); + close( arch ); + for n := 1 to tam - 1 do + begin + hubosel := false; + sel := n; + for i := n + 1 to tam do + begin + m.Comp := m.Comp + 1; + Retardar( RETARDO ); + if datos[sel].ap > datos[i].ap then + begin + sel := i; + hubosel := true; + end; + end; + if hubosel then Intercambiar( datos[n], datos[sel], m.Int); + end; + GetHora( h2 ); + m.Tiem := GetTiempo( h1, h2 ); + end; { procedure SelectionSort } + + (*********************************************************) + + procedure InsertionSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); + var + h1, h2: HORA; + i, j, k: integer; + tmp: PERSONA; + terminar: boolean; + + begin + GetHora( h1 ); + m.Comp := 0; + m.Int := 0; + reset( arch ); + CargarTabla( arch, datos, 1000 ); + close( arch ); + for i := 2 to tam do + begin + m.Int := m.Int + 1; + Retardar( RETARDO ); + tmp := datos[i]; + j := i - 1; + terminar := false; + while ( j >= 1 ) and ( not terminar ) do + begin + m.Comp := m.Comp + 1; + Retardar( RETARDO ); + if ( tmp.ap < datos[j].ap ) then + begin + m.Int := m.Int + 1; + Retardar( RETARDO ); + datos[j+1] := datos[j]; + j := j - 1; + end + else terminar := true; + end; + m.Int := m.Int + 1; + Retardar( RETARDO ); + datos[j+1] := tmp; + end; + GetHora( h2 ); + m.Tiem := GetTiempo( h1, h2 ); + end; { procedure InsertionSort } + + (*********************************************************) + + procedure ShellSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); + var + h1, h2: HORA; + hueco, i, j: integer; + huboint: boolean; + + begin + GetHora( h1 ); + m.Comp := 0; + m.Int := 0; + reset( arch ); + CargarTabla( arch, datos, 1000 ); + close( arch ); + hueco := tam; + while hueco > 1 do + begin + hueco := hueco div 2; + huboint := true; + while huboint do + begin + huboint := false; + for i := 1 to tam - hueco do + begin + j := i + hueco; + m.Comp := m.Comp + 1; + Retardar( RETARDO ); + if ( datos[i].ap > datos[j].ap ) then + begin + Intercambiar( datos[i], datos[j], m.Int ); + huboint := true; + end; + end; + end; + end; + GetHora( h2 ); + m.Tiem := GetTiempo( h1, h2 ); + end; { procedure ShellSort } + + (*********************************************************) + + procedure ShellSortMej( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); + + (*********************************************************) + + procedure Shell( var datos: TABLA; hueco, i: integer; var comp, int: longint ); + var + j: integer; + + begin + j := i + hueco; + comp := comp + 1; + Retardar( RETARDO ); + if ( datos[i].ap > datos[j].ap ) then + begin + Intercambiar( datos[i], datos[j], int ); + if (i - hueco) > 0 then + Shell( datos, hueco, i - hueco, comp, int ); + end; + end; { procedure Shell } + + (*********************************************************) + + var { procedure ShellSortMej } + h1, h2: HORA; + hueco, i, j: integer; + + begin + GetHora( h1 ); + m.Comp := 0; + m.Int := 0; + reset( arch ); + CargarTabla( arch, datos, 1000 ); + close( arch ); + hueco := tam; + while hueco > 1 do + begin + hueco := hueco div 2; + for i := 1 to tam - hueco do + begin + j := i + hueco; + m.Comp := m.Comp + 1; + Retardar( RETARDO ); + if ( datos[i].ap > datos[j].ap ) then + begin + Intercambiar( datos[i], datos[j], m.Int ); + if (i - hueco) > 0 then + Shell( datos, hueco, i - hueco, m.Comp, m.Int ); + end; + end; + end; + GetHora( h2 ); + m.Tiem := GetTiempo( h1, h2 ); + end; { procedure ShellSortMej } + + (*********************************************************) + + procedure QuickSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); + + (*********************************************************) + + procedure QSort( var datos: TABLA; min, max: integer; var comp, int: longint ); + + var + i, j: integer; + sel: PERSONA; + flag: boolean; + + begin + sel := datos[( min + max ) div 2]; + i := min; + j := max; + repeat + comp := comp + 1; + Retardar( RETARDO ); + flag := false; + while datos[i].ap < sel.ap do + begin + if flag then begin + comp := comp + 1; + Retardar( RETARDO ); + end + else flag := true; + i := i + 1; + end; + comp := comp + 1; + Retardar( RETARDO ); + flag := false; + while datos[j].ap > sel.ap do + begin + if flag then begin + comp := comp + 1; + Retardar( RETARDO ); + end + else flag := true; + j := j - 1; + end; + if i <= j then + begin + if i < j then Intercambiar( datos[i], datos[j], int ); + i := i + 1; + j := j - 1; + end; + until i > j; + if min < j then QSort( datos, min, j, comp, int); + if i < max then QSort( datos, i, max, comp, int); + end; { procedure QSort } + + (*********************************************************) + + var + h1, h2: HORA; + + begin { procedure QuickSort } + GetHora( h1 ); + m.Comp := 0; + m.Int := 0; + reset( arch ); + CargarTabla( arch, datos, 1000 ); + close( arch ); + QSort( datos, 1, 1000, m.Comp, m.Int ); + GetHora( h2 ); + m.Tiem := GetTiempo( h1, h2 ); + end; { procedure QuickSort } + + (*********************************************************) + + begin { procedure EvaluarCre } + if ExisteArchivo( 'DATOS.TXT' ) then + begin + BubbleSort( arch, datos, 1000, bs ); + BubbleSortMej( arch, datos, 1000, bsm ); + ShakeSort( arch, datos, 1000, shs ); + RippleSort( arch, datos, 1000, rs ); + SelectionSort( arch, datos, 1000, ss ); + InsertionSort( arch, datos, 1000, is ); + ShellSort( arch, datos, 1000, sls ); + ShellSortMej( arch, datos, 1000, slsm ); + QuickSort( arch, datos, 1000, qs ); + CrearInforme( CRECIENTE ); + end + else + NoExisteArch; + end; { procedure EvaluarCre } + + (*********************************************************) + + procedure EvaluarDec( var datos: TABLA; var arch: text ); + + (*********************************************************) + + procedure BubbleSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); + + var + i, j: integer; + h1, h2: HORA; + + begin + GetHora( h1 ); + m.Comp := 0; + m.Int := 0; + reset( arch ); + CargarTabla( arch, datos, 1000 ); + close( arch ); + for i := tam - 1 downto 1 do + begin + for j := tam - 1 downto 1 do + begin + m.Comp := m.Comp + 1; + Retardar( RETARDO ); + if datos[j].ap < datos[j+1].ap then + Intercambiar( datos[j], datos[j+1], m.Int); + end; + end; + GetHora( h2 ); + m.Tiem := GetTiempo( h1, h2 ); + end; { procedure BubbleSort } + + (*********************************************************) + + procedure BubbleSortMej( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); + + var + huboint: boolean; + i, n: integer; + h1, h2: HORA; + + begin + GetHora( h1 ); + m.Comp := 0; + m.Int := 0; + n := 1; + reset( arch ); + CargarTabla( arch, datos, 1000 ); + close( arch ); + huboint := true; + while huboint do + begin + huboint := false; + for i := tam - 1 downto n do + begin + m.Comp := m.Comp + 1; + Retardar( RETARDO ); + if datos[i].ap < datos[i+1].ap then + begin + Intercambiar( datos[i], datos[i+1], m.Int); + huboint := true; + end; + end; + n := n + 1; + end; + GetHora( h2 ); + m.Tiem := GetTiempo( h1, h2 ); + end; { procedure BubbleSortMej } + + (*********************************************************) + + procedure ShakeSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); + var + h1, h2: HORA; + i, d, j, tmp: integer; + + begin + GetHora( h1 ); + m.Comp := 0; + m.Int := 0; + reset( arch ); + CargarTabla( arch, datos, 1000 ); + close( arch ); + i := 2; + d := tam; + tmp := tam; + repeat + for j := d downto i do + begin + m.Comp := m.Comp + 1; + Retardar( RETARDO ); + if datos[j].ap > datos[j-1].ap then + begin + Intercambiar( datos[j], datos[j-1], m.Int ); + tmp := j; + end; + end; + i := tmp + 1; + for j := i to d do + begin + m.Comp := m.Comp + 1; + Retardar( RETARDO ); + if datos[j].ap > datos[j-1].ap then + begin + Intercambiar( datos[j], datos[j-1], m.Int ); + tmp := j; + end; + end; + d := tmp - 1; + until i >= d; + GetHora( h2 ); + m.Tiem := GetTiempo( h1, h2 ); + end; { procedure ShakeSort } + + (*********************************************************) + + procedure RippleSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); + var + h1, h2: HORA; + i, j: integer; + + begin + GetHora( h1 ); + m.Comp := 0; + m.Int := 0; + reset( arch ); + CargarTabla( arch, datos, 1000 ); + close( arch ); + for i := 1 to tam do + begin + for j := i + 1 to tam do + begin + m.Comp := m.Comp + 1; + Retardar( RETARDO ); + if datos[i].ap < datos[j].ap then Intercambiar( datos[i], datos[j], m.Int ); + end; + end; + GetHora( h2 ); + m.Tiem := GetTiempo( h1, h2 ); + end; { procedure RippleSort } + + (*********************************************************) + + procedure SelectionSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); + var + i, sel, n: integer; + hubosel: boolean; + h1, h2: HORA; + + begin + GetHora( h1 ); + m.Comp := 0; + m.Int := 0; + reset( arch ); + CargarTabla( arch, datos, 1000 ); + close( arch ); + for n := 1 to tam - 1 do + begin + hubosel := false; + sel := n; + for i := n + 1 to tam do + begin + m.Comp := m.Comp + 1; + Retardar( RETARDO ); + if datos[sel].ap < datos[i].ap then + begin + sel := i; + hubosel := true; + end; + end; + if hubosel then Intercambiar( datos[n], datos[sel], m.Int); + end; + GetHora( h2 ); + m.Tiem := GetTiempo( h1, h2 ); + end; { procedure SelectionSort } + + (*********************************************************) + + procedure InsertionSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); + var + h1, h2: HORA; + i, j, k: integer; + tmp: PERSONA; + terminar: boolean; + + begin + GetHora( h1 ); + m.Comp := 0; + m.Int := 0; + reset( arch ); + CargarTabla( arch, datos, 1000 ); + close( arch ); + for i := 2 to tam do + begin + m.Int := m.Int + 1; + Retardar( RETARDO ); + tmp := datos[i]; + j := i - 1; + terminar := false; + while ( j >= 1 ) and ( not terminar ) do + begin + m.Comp := m.Comp + 1; + Retardar( RETARDO ); + if ( tmp.ap > datos[j].ap ) then + begin + m.Int := m.Int + 1; + Retardar( RETARDO ); + datos[j+1] := datos[j]; + j := j - 1; + end + else terminar := true; + end; + m.Int := m.Int + 1; + Retardar( RETARDO ); + datos[j+1] := tmp; + end; + GetHora( h2 ); + m.Tiem := GetTiempo( h1, h2 ); + end; { procedure InsertionSort } + + (*********************************************************) + + procedure ShellSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); + var + h1, h2: HORA; + hueco, i, j: integer; + huboint: boolean; + + begin + GetHora( h1 ); + m.Comp := 0; + m.Int := 0; + reset( arch ); + CargarTabla( arch, datos, 1000 ); + close( arch ); + hueco := tam; + while hueco > 1 do + begin + hueco := hueco div 2; + huboint := true; + while huboint do + begin + huboint := false; + for i := 1 to tam - hueco do + begin + j := i + hueco; + m.Comp := m.Comp + 1; + Retardar( RETARDO ); + if ( datos[i].ap < datos[j].ap ) then + begin + Intercambiar( datos[i], datos[j], m.Int ); + huboint := true; + end; + end; + end; + end; + GetHora( h2 ); + m.Tiem := GetTiempo( h1, h2 ); + end; { procedure ShellSort } + + (*********************************************************) + + procedure ShellSortMej( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); + + (*********************************************************) + + procedure Shell( var datos: TABLA; hueco, i: integer; + var comp: longint; var int: longint ); + var + j: integer; + + begin + j := i + hueco; + comp := comp + 1; + Retardar( RETARDO ); + if ( datos[i].ap < datos[j].ap ) then + begin + Intercambiar( datos[i], datos[j], int ); + if (i - hueco) > 0 then + Shell( datos, hueco, i - hueco, comp, int ); + end; + end; { procedure Shell } + + (*********************************************************) + + var { procedure ShellSortMej } + h1, h2: HORA; + hueco, i, j: integer; + + begin + GetHora( h1 ); + m.Comp := 0; + m.Int := 0; + reset( arch ); + CargarTabla( arch, datos, 1000 ); + close( arch ); + hueco := tam; + while hueco > 1 do + begin + hueco := hueco div 2; + for i := 1 to tam - hueco do + begin + j := i + hueco; + m.Comp := m.Comp + 1; + Retardar( RETARDO ); + if ( datos[i].ap < datos[j].ap ) then + begin + Intercambiar( datos[i], datos[j], m.Int ); + if (i - hueco) > 0 then + Shell( datos, hueco, i - hueco, m.Comp, m.Int ); + end; + end; + end; + GetHora( h2 ); + m.Tiem := GetTiempo( h1, h2 ); + end; { procedure ShellSortMej } + + (*********************************************************) + + procedure QuickSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); + + procedure QSort( var datos: TABLA; min, max: integer; + var comp: longint; var int: longint ); + + var + i, j: integer; + sel: PERSONA; + flag: boolean; + + begin + sel := datos[( min + max ) div 2]; + i := min; + j := max; + repeat + comp := comp + 1; + Retardar( RETARDO ); + flag := false; + while datos[i].ap > sel.ap do + begin + if flag then begin + comp := comp + 1; + Retardar( RETARDO ); + end + else flag := true; + i := i + 1; + end; + comp := comp + 1; + Retardar( RETARDO ); + flag := false; + while datos[j].ap < sel.ap do + begin + if flag then begin + comp := comp + 1; + Retardar( RETARDO ); + end + else flag := true; + j := j - 1; + end; + if i <= j then + begin + if i < j then Intercambiar( datos[i], datos[j], int ); + i := i + 1; + j := j - 1; + end; + until i > j; + if min < j then QSort( datos, min, j, comp, int); + if i < max then QSort( datos, i, max, comp, int); + end; { procedure QSort } + + (*********************************************************) + + var + h1, h2: HORA; + + begin { procedure QuickSort } + GetHora( h1 ); + m.Comp := 0; + m.Int := 0; + reset( arch ); + CargarTabla( arch, datos, 1000 ); + close( arch ); + QSort( datos, 1, 1000, m.Comp, m.Int ); + GetHora( h2 ); + m.Tiem := GetTiempo( h1, h2 ); + end; { procedure QuickSort } + + (*********************************************************) + + begin { procedure EvaluarDec } + if ExisteArchivo( 'DATOS.TXT' ) then + begin + BubbleSort( arch, datos, 1000, bs ); + BubbleSortMej( arch, datos, 1000, bsm ); + ShakeSort( arch, datos, 1000, shs ); + RippleSort( arch, datos, 1000, rs ); + SelectionSort( arch, datos, 1000, ss ); + InsertionSort( arch, datos, 1000, is ); + ShellSort( arch, datos, 1000, sls ); + ShellSortMej( arch, datos, 1000, slsm ); + QuickSort( arch, datos, 1000, qs ); + CrearInforme( DECRECIENTE ); + end + else + NoExisteArch; + end; { procedure EvaluarDec } + + (*********************************************************) + + var { procedure MenuEvaluar } + tecla: char; + + begin + clrscr; + textcolor( Yellow ); + gotoxy( 19, 3 ); + writeln( 'COMPARACION DE ALGORITMOS DE ORDENAMIENTO' ); + gotoxy( 19, 4 ); + writeln( '~~~~~~~~~~~ ~~ ~~~~~~~~~~ ~~ ~~~~~~~~~~~~' ); + textcolor( LightCyan ); + gotoxy( 1, 7 ); + writeln( ' Evaluar Algoritmos:' ); + writeln( ' ------- ----------' ); + textcolor( LightGray ); + writeln; + writeln; + writeln( ' 1.- Ordenando en forma creciente.' ); + writeln( ' 2.- Ordenando en forma decreciente.' ); + writeln( ' 0.- Men£ Anterior.' ); + gotoxy( 1, 20 ); + textcolor( White ); + write( ' Ingrese su opci¢n: ' ); + textcolor( Yellow ); + tecla := readkey; + while ( ( tecla < '1' ) or ( tecla > '2' ) ) and ( tecla <> '0' ) do + begin + textcolor( White ); + gotoxy( 1, 20 ); + write( ' Ingrese su opci¢n (1, 2 o 0): ' ); + textcolor( Yellow ); + tecla := readkey; + end; + case tecla of + '1': if ExisteArchivo( 'DATOS.TXT' ) then EvaluarCre( datos, arch ) + else NoExisteArch; + '2': if ExisteArchivo( 'DATOS.TXT' ) then EvaluarDec( datos, arch ) + else NoExisteArch; + '0': ; + end; + end; + +(*********************************************************) +(*********************************************************) + + procedure MenuGenerar( var arch: text ); + + type + TIPO_LETRA = ( TL_VOCAL, TL_CONSO ); + TIPO_VOCAL = ( TV_AEIOU, TV_EI ); + 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 ); + + (*********************************************************) + + function GetRNDApellido( max, min: integer ): APELLIDO; + + (*********************************************************) + + function GetVocal( tipo: TIPO_VOCAL ): char; + + var + valor: integer; + + begin + if tipo = TV_AEIOU then valor := random( 16 ) + else valor := random( 6 ) + 5; + case valor of + 0..4: GetVocal := 'A'; + 5..7: GetVocal := 'E'; + 8..10: GetVocal := 'I'; + 11..13: GetVocal := 'O'; + 14..15: GetVocal := 'U'; + end; + end; { function GetVocal } + + (*********************************************************) + + procedure GetRNDVocal( var indic: INDICADOR; var proxl: TIPO_LETRA; var vocal: char ); + + var + valor: integer; + + begin + case indic of + I_ESQ: + begin + vocal := 'U'; + indic := I_ESQU; + proxl := TL_VOCAL; + end; + I_ESQU: + begin + vocal := GetVocal( TV_EI ); + indic := I_NADA; + proxl := TL_CONSO; + end; + else + begin + vocal := GetVocal( TV_AEIOU ); + indic := I_NADA; + if random( 40 ) = 0 then proxl := TL_VOCAL + else proxl := TL_CONSO; + end; + end; + end; { procedure GetRNDVocal } + + (*********************************************************) + + procedure GetRNDConsonante( var indic: INDICADOR; var proxl: TIPO_LETRA; var conso: char ); + + var + valor: integer; + + begin + proxl := TL_VOCAL; + indic := I_NADA; + + case indic of + I_ESF, I_ESR, I_ESG, I_EST: conso := 'R'; + I_ESB: case random( 2 ) of + 0: conso := 'R'; + 1: conso := 'L'; + end; + I_ESC: case random( 4 ) of + 0: conso := 'C'; + 1: conso := 'H'; + 2: conso := 'R'; + 3: conso := 'L'; + end; + I_ESL: case random( 6 ) of + 0: conso := 'T'; + 1..5: conso := 'L'; + end; + I_ESM: case random( 3 ) of + 0: conso := 'P'; + 1: conso := 'B'; + 2: conso := 'L'; + end; + I_ESN: case random( 3 ) of + 0: conso := 'R'; + 1: conso := 'V'; + 2: conso := 'C'; + end; + else case random( 55 ) of + 0..3: begin + conso := 'B'; + if random( 10 ) = 0 then begin + indic := I_ESB; + proxl := TL_CONSO; + end; + end; + 4..7: begin + conso := 'C'; + if random( 5 ) = 0 then begin + indic := I_ESC; + proxl := TL_CONSO; + end; + end; + 8..11: conso := 'D'; + 12..14: begin + conso := 'F'; + if random( 10 ) = 0 then begin + indic := I_ESF; + proxl := TL_CONSO; + end; + end; + 15..17: begin + conso := 'G'; + if random( 5 ) = 0 then + begin + indic := I_ESG; + if random( 4 ) = 0 then proxl := TL_CONSO; + end; + end; + 18..19: conso := 'H'; + 20..22: conso := 'J'; + 23..24: conso := 'K'; + 25..27: begin + conso := 'L'; + if random( 15 ) = 0 then + begin + indic := I_ESL; + proxl := TL_CONSO; + end; + end; + 28..30: begin + conso := 'M'; + if random( 5 ) = 0 then + begin + indic := I_ESM; + proxl := TL_CONSO; + end; + end; + 31..33: begin + conso := 'N'; + if random( 5 ) = 0 then + begin + indic := I_ESN; + proxl := TL_CONSO; + end; + end; + 34..36: conso := 'P'; + 37..38: begin + conso := 'Q'; + indic := I_ESQ; + end; + 39..41: begin + conso := 'R'; + if random( 3 ) = 0 then + begin + indic := I_ESR; + proxl := TL_CONSO; + end; + end; + 42..44: conso := 'S'; + 45..47: begin + conso := 'T'; + if random( 10 ) = 0 then + begin + indic := I_EST; + proxl := TL_CONSO; + end; + end; + 48..50: conso := 'V'; + 51: conso := 'W'; + 52: conso := 'X'; + 53: conso := 'Y'; + 54: conso := 'Z'; + end; { case random( 55 ) of } + + end; { case indic of } + end; { procedure GetRNDConsonante } + + (*********************************************************) + + var { function GetRNDApellido } + tam, i: integer; + aux: char; + apel: APELLIDO; + indic: INDICADOR; + proxl: TIPO_LETRA; + + begin + if max > MAX_APE then max := MAX_APE; + tam := random( max + 1 ) + min; + indic := I_NADA; + apel := ''; + if random( 5 ) = 0 then proxl := TL_VOCAL + else proxl := TL_CONSO; + for i := 1 to tam do + begin + if proxl = TL_CONSO then GetRNDConsonante( indic, proxl, aux ) + else GetRNDVocal( indic, proxl, aux ); + apel := apel + aux; + end; + GetRNDApellido := apel; + end; { function GetRNDApellido } + + (*********************************************************) + + function GetRNDLetra( min, max: char ): char; + + begin + GetRNDLetra := chr( random( ord( max ) - ord( min ) + 1 ) + ord( min ) ); + end; + + (*********************************************************) + + procedure GetOrdApellidos( var ar: text; cant: integer ); + + var + mil: boolean; + letra, letra1: char; + i, j, veces: integer; + dni: DOCUMENTO; + ap, ape, apel: APELLIDO; + + begin + mil := false; + if cant = 1000 then mil := true; + dni := 10000000 + (random( 15000 ) * 100); + ap := ''; + ape := ''; + apel := ''; + for letra := 'A' to 'Z' do + begin + ap := letra; + for letra1 := 'A' to 'Z' do + begin + if mil then + case letra of + 'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T': + case letra1 of + 'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T', 'Z': veces := 2; + else veces := 1; + end; + else case letra1 of + 'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T': veces := 2; + else veces := 1; + end; + end + else + case letra of + 'A', 'B', 'C', 'D', 'E', 'F', 'I', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T', 'V': + case letra1 of + 'D', 'F', 'G', 'H', 'I', 'J', 'K', 'U', 'V': veces := 2; + else veces := 1; + end; + else case letra1 of + 'D', 'F', 'G', 'H', 'I', 'J', 'K', 'U': veces := 2; + else veces := 1; + end; + end; + ape := ap + letra1; + for j := 1 to veces do + begin + if j = 1 then apel := ape + GetRNDLetra( 'A', 'M' ) + GetRNDApellido( 6, 1 ) + else apel := ape + GetRNDLetra( 'N', 'Z' ) + GetRNDApellido( 6, 1 ); + dni := dni + random( 50000 ) + 1; + writeln( ar, apel ); + writeln( ar, dni ); + writeln( ar ); + apel := ''; + end; + + ape := ''; + + end; { for letra1 := 'A' to 'Z' do } + + ap := ''; + + end; { for letra := 'A' to 'Z' do } + + end; { procedure GetOrdApellidos } + + (*********************************************************) + + procedure GetInvOrdApellidos( var ar: text; cant: integer ); + + var + mil: boolean; + letra, letra1: char; + i, j, veces: integer; + dni: DOCUMENTO; + ap, ape, apel: APELLIDO; + + begin + mil := false; + if cant = 1000 then mil := true; + dni := 34000000 + (random( 15000 ) * 100); + ap := ''; + ape := ''; + apel := ''; + for letra := 'Z' downto 'A' do + begin + ap := letra; + for letra1 := 'Z' downto 'A' do + begin + if mil then + case letra of + 'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T': + case letra1 of + 'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T', 'Z': veces := 2; + else veces := 1; + end; + else case letra1 of + 'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T': veces := 2; + else veces := 1; + end; + end + else + case letra of + 'A', 'B', 'C', 'D', 'E', 'F', 'I', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T', 'V': + case letra1 of + 'D', 'F', 'G', 'H', 'I', 'J', 'K', 'U', 'V': veces := 2; + else veces := 1; + end; + else case letra1 of + 'D', 'F', 'G', 'H', 'I', 'J', 'K', 'U': veces := 2; + else veces := 1; + end; + end; + ape := ap + letra1; + for j := 1 to veces do + begin + if j <> 1 then apel := ape + GetRNDLetra( 'A', 'M' ) + GetRNDApellido( 6, 1 ) + else apel := ape + GetRNDLetra( 'N', 'Z' ) + GetRNDApellido( 6, 1 ); + dni := dni - random( 40000 ) - 1; + writeln( ar, apel ); + writeln( ar, dni ); + writeln( ar ); + apel := ''; + end; + + ape := ''; + + end; { for letra1 := 'A' to 'Z' do } + + ap := ''; + + end; { for letra := 'A' to 'Z' do } + + end; { GetInvOrdApellidos } + + + (*********************************************************) + + procedure GenerarRND( var arch: text; n: integer; reabrir: boolean ); + + var + i: integer; + ap: APELLIDO; + dni: DOCUMENTO; + + begin + if reabrir then rewrite( arch ); + dni := 10000000 + (random( 15000 ) * 100); + + for i := 1 to n do + begin + ap := GetRNDApellido( 8, 4 ); + dni := dni + random( 50000 ) + 1; + writeln( arch, ap ); + writeln( arch, dni ); + writeln( arch ); + end; + if reabrir then close( arch ); + end; { procedure GenerarRND } + + (*********************************************************) + + procedure GenerarOrd( var arch: text; n: integer; reabrir: boolean ); + + begin + if reabrir then rewrite( arch ); + GetOrdApellidos( arch, n ); + if reabrir then close( arch ); + end; + + (*********************************************************) + + procedure GenerarOrdDec( var arch: text; n: integer; reabrir: boolean ); + + begin + if reabrir then rewrite( arch ); + GetInvOrdApellidos( arch, n ); + if reabrir then close( arch ); + end; + + (*********************************************************) + + procedure Generar90Ord( var arch: text ); + + begin + rewrite( arch ); + GenerarOrd( arch, 900, false ); + GenerarRND( arch, 100, false ); + close( arch ); + end; + + (*********************************************************) + + procedure Generar90OrdDec( var arch: text ); + + begin + rewrite( arch ); + GenerarOrdDec( arch, 900, false ); + GenerarRND( arch, 100, false ); + close( arch ); + end; + + (*********************************************************) + + var { procedure MenuGenerar } + tecla: char; + + begin + clrscr; + textcolor( Yellow ); + gotoxy( 19, 3 ); + writeln( 'COMPARACION DE ALGORITMOS DE ORDENAMIENTO' ); + gotoxy( 19, 4 ); + writeln( '~~~~~~~~~~~ ~~ ~~~~~~~~~~ ~~ ~~~~~~~~~~~~' ); + textcolor( LightCyan ); + gotoxy( 1, 7 ); + writeln( ' Generar Archivo (''DATOS.TXT''):' ); + writeln( ' ------- ------- -------------' ); + textcolor( LightGray ); + writeln; + writeln; + writeln( ' 1.- Con datos desordenados.' ); + writeln( ' 2.- Con datos en orden creciente (APELLIDO, DNI).' ); + writeln( ' 3.- Con datos en orden decreciente (APELLIDO, DNI).' ); + writeln( ' 4.- Con 90% datos en orden creciente (APELLIDO, DNI) + 10% desordenado.' ); + writeln( ' 5.- Con 90% datos en orden decreciente (APELLIDO, DNI) + 10% desordenado.' ); + writeln( ' 0.- Men£ Anterior.' ); + gotoxy( 1, 20 ); + textcolor( White ); + write( ' Ingrese su opci¢n: ' ); + textcolor( Yellow ); + tecla := readkey; + while ( ( tecla < '1' ) or ( tecla > '5' ) ) and ( tecla <> '0' ) do + begin + textcolor( White ); + gotoxy( 1, 20 ); + write( ' Ingrese su opci¢n (1 a 5 o 0): ' ); + textcolor( Yellow ); + tecla := readkey; + end; + case tecla of + '1': GenerarRND( arch, 1000, true ); + '2': GenerarOrd( arch, 1000, true ); + '3': GenerarOrdDec( arch, 1000, true ); + '4': Generar90Ord( arch ); + '5': Generar90OrdDec( arch ); + '0': ; + end; + end; { procedure MenuGenerar } + +(*********************************************************) + + procedure PantallaSalida; + + begin + writeln; + NormVideo; + clrscr; + writeln; + textcolor( white ); + writeln( ' COMPARACION DE ALGORITMOS DE ORDENAMIENTO versi¢n ', VERSION, ' <-o-o-> Luca - Soft' ); + NormVideo; + writeln( ' Desarrollado por Leandro Lucarella para la Facultad de Ingenier¡a de la' ); + writeln( ' Universidad de Buenos Aires. Consultas, sugerencias y/o reprobaciones a:' ); + writeln; + textcolor( LightMagenta ); + write( ' lluca@cnba.uba.ar' ); + NormVideo; + write( ' o ' ); + textcolor( LightMagenta ); + writeln( 'lluca@geocities.com' ); + NormVideo; + writeln; + writeln( ' (c) 1999 - Todos los derechos reservados.' ); + delay( 750 ); + end; + +(*********************************************************) + +var { programa } + datos: TABLA; + arch: text; + tecla: char; + salir: boolean; + +begin + randomize; + assign( arch, 'DATOS.TXT' ); + salir := false; + textbackground( Blue ); + + while not salir do + begin + clrscr; + textcolor( Yellow ); + gotoxy( 19, 3 ); + writeln( 'COMPARACION DE ALGORITMOS DE ORDENAMIENTO' ); + gotoxy( 19, 4 ); + writeln( '~~~~~~~~~~~ ~~ ~~~~~~~~~~ ~~ ~~~~~~~~~~~~' ); + gotoxy( 1, 7 ); + textcolor( LightCyan ); + writeln( ' Men£ Principal:' ); + writeln( ' ---- ---------' ); + textcolor( LightGray ); + writeln; + writeln; + writeln( ' 1.- Generar Archivo (''DATOS.TXT'').' ); + writeln( ' 2.- Evaluar Algoritmos.' ); + writeln( ' 0.- Salir.' ); + gotoxy( 1, 20 ); + textcolor( White ); + write( ' Ingrese su opci¢n: ' ); + textcolor( Yellow ); + tecla := readkey; + while ( ( tecla < '1' ) or ( tecla > '2' ) ) and ( tecla <> '0' ) do + begin + textcolor( White ); + gotoxy( 1, 20 ); + write( ' Ingrese su opci¢n (1, 2 o 0): ' ); + textcolor( Yellow ); + tecla := readkey; + end; + case tecla of + '1': MenuGenerar( arch ); + '2': MenuEvaluar( datos, arch ); + '0': salir := true; + end; + end; + PantallaSalida; end. \ No newline at end of file