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