ErrorDeSintaxis

Pequeños fragmentos de código fuente en distintos lenguajes de programación, agrupados por categorías.

Puedes buscar entre los fuentes existentes, o aportar los tuyos.

Pascal: Ordenar mediante burbuja y quicksort

Ordenar los datos de un array mediante burbuja y quicksort

Lenguaje: Pascal (compilador: Turbo Pascal 7)

Categoría: Tipos de datos

(* Fuente procedente de ErrorDeSintaxis.es *)
(* Ordenar los datos de un array mediante burbuja *)
(*  y quicksort *)
(* Lenguaje: Pascal *)
(* Compilador: Turbo Pascal 7 *)
(* Nivel: Básico *)
(* Disponible desde 17/07/2011 *)
(* Aportado por Nacho *)
(* Autor original: Nacho Cabanes *)
(* Web original: http://www.freepascal.es/tutorials/cupasamp02c.php *)


Notice: Undefined index: HARDQUOTE in /home/u801964362/domains/errordesintaxis.es/public_html/csintaxis/geshi.php on line 2398

Notice: Undefined index: HARDESCAPE in /home/u801964362/domains/errordesintaxis.es/public_html/csintaxis/geshi.php on line 2399

Notice: Undefined index: HARDQUOTE in /home/u801964362/domains/errordesintaxis.es/public_html/csintaxis/geshi.php on line 2398

Notice: Undefined index: HARDESCAPE in /home/u801964362/domains/errordesintaxis.es/public_html/csintaxis/geshi.php on line 2399

Notice: Undefined index: HARDQUOTE in /home/u801964362/domains/errordesintaxis.es/public_html/csintaxis/geshi.php on line 2398

Notice: Undefined index: HARDESCAPE in /home/u801964362/domains/errordesintaxis.es/public_html/csintaxis/geshi.php on line 2399

Notice: Undefined index: HARDQUOTE in /home/u801964362/domains/errordesintaxis.es/public_html/csintaxis/geshi.php on line 2398

Notice: Undefined index: HARDESCAPE in /home/u801964362/domains/errordesintaxis.es/public_html/csintaxis/geshi.php on line 2399

Notice: Undefined index: HARDQUOTE in /home/u801964362/domains/errordesintaxis.es/public_html/csintaxis/geshi.php on line 2398

Notice: Undefined index: HARDESCAPE in /home/u801964362/domains/errordesintaxis.es/public_html/csintaxis/geshi.php on line 2399
program Ordenar;
 
 const 
   maximo = 100;          { Número de datos } 
   maxVal = 30000;        { Maximo valor que pueden tomar }
 
 var 
   datos: array[1..maximo] of integer;     { Los datos en sí } 
   i: integer;                             { Para bucles }
 
 procedure swap(var a,b: integer);         { Intercambia dos datos } 
 var 
   tmp: integer; 
 begin 
   tmp := a; 
   a := b; 
   b := tmp; 
 end;
 
 procedure generaNumeros;               { Genera números aleatorios } 
 begin 
   writeln; 
   writeln('Generando números...'); 
   for i := 1 to maximo do 
     datos[i] := random(maxVal); 
 end;
 
 procedure muestraNumeros;              { Muestra los núms almacenados } 
 begin 
   writeln; 
   writeln('Los números son...'); 
   for i := 1 to maximo do 
     write(datos[i], ' '); 
   writeln; 
 end; 
 
 procedure Burbuja;                     { Ordena según burbuja } 
 var 
   cambiado: boolean; 
 begin 
   writeln; 
   writeln('Ordenando mediante burbuja...'); 
   repeat 
     cambiado := false;                 { No cambia nada aún } 
     for i := maximo downto 2 do        { De final a principio } 
       if datos[i] < datos[i-1] then    { Si está colocado al revés } 
         begin 
         swap(datos[i], datos[i-1]);    { Le da la vuelta } 
         cambiado := true;              { Y habrá que seguir mirando } 
         end; 
   until not cambiado;                  { Hasta q nada se haya cambiado } 
 end;
 
 procedure QuickSort;                   { Ordena según Quicksort } 
 
 procedure Sort(l, r: Integer);         { Esta es la parte recursiva } 
 var 
   i, j, x, y: integer; 
 begin 
   i := l; j := r;                      { Límites por los lados } 
   x := datos[(l+r) DIV 2];             { Centro de la comparaciones } 
   repeat 
     while datos[i] < x do i := i + 1;  { Salta los ya colocados } 
     while x < datos[j] do j := j - 1;  {   en ambos lados } 
     if i <= j then                     { Si queda alguno sin colocar } 
       begin 
       swap(datos[i], datos[j]);        { Los cambia de lado } 
       i := i + 1; j := j - 1;          { Y sigue acercándose al centro } 
       end; 
   until i > j;                         { Hasta que lo pasemos } 
   if l < j then Sort(l, j);            { Llamadas recursivas por cada } 
   if i < r then Sort(i, r);            {   lado } 
 end; 
 
 begin                              { Esto llama a la parte recursiva } 
   writeln; 
   writeln('Ordenando mediante QuickSort...'); 
   Sort(1,Maximo); 
 end;
 
 
 { ------------ Cuerpo del programa ------------- } 
 begin 
   randomize; 
   generaNumeros; 
   muestraNumeros; 
   Burbuja; 
   muestraNumeros; 
   readln; 
   generaNumeros; 
   muestraNumeros; 
   QuickSort; 
   muestraNumeros; 
   readln; 
 end.