+++ /dev/null
-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 );
- 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 );
- 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: longint; reabrir: boolean );
-
- var
- i: integer;
- ap: APELLIDO;
-
- begin
- if reabrir then rewrite( arch );
-
- for i := 1 to n do
- begin
- ap := GetRNDApellido( 30, 4 );
- writeln( arch, ap );
- 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, 1000000, 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
projects / z.facultad / 75.06 / emufs.git / commitdiff