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: Búsqueda binaria

Búsqueda binaria en los datos de un array ordenado

Lenguaje: Pascal (compilador: Turbo Pascal 7)

Categoría: Tipos de datos

(* Fuente procedente de ErrorDeSintaxis.es *)
(* Búsqueda binaria en los datos de un array *)
(*  ordenado *)
(* 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/cupasamp03.php *)

program BuscaBin;        {  Búsqueda binaria }
 
 const 
   maximo = 400;          { Número de datos } 
   maxVal = 500;          { Maximo valor que pueden tomar }
 
 var 
   datos: array[1..maximo] of integer;     { Los datos en sí } 
   i: integer;                             { Para bucles } 
   donde: integer;                         { Posicion en la que ha } 
                                           {   aparecido }
 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; 
 
 function Buscar(minimo, maximo, valor: integer): integer; 
                                       { Búsqueda binaria } 
 var 
   medio: integer;
 begin
   writeln('Mirando entre ', minimo, ' y ', maximo, 
     ', de valores ', datos[minimo], ' y ', datos[maximo]);
 
   if minimo >= maximo then         { Si la anchura ya es 1 }
    if datos[minimo]=valor then    {   y el valor es el buscado } 
       buscar := minimo            {   devolvemos su posición } 
     else buscar := -1             { Si es otro valor -> no está }
   else                            { Si la anchura no es 1 } 
     begin 
     medio := round((minimo+maximo)/2);      { Hallamos el centro }
     if valor = datos[medio] then            { Comparamos con su valor }
       buscar := medio                       { Si acertamos, ya esta }
     else if valor > datos[medio] then       { Si no, }
       buscar := buscar(medio+1,maximo,valor)  { Miramos el lado corresp}
     else
       buscar := buscar(minimo,medio-1,valor)
     end;
 end;
 
 { ------------ Cuerpo del programa ------------- }
 begin
   randomize;
   generaNumeros;
   Burbuja;
   muestraNumeros;
   writeln('Buscando ',maxVal div 2,'...');
   donde := Buscar(1,maximo, maxVal div 2);
   if donde = -1 then writeln('No se ha encontrado')
     else writeln('Está en la posición ',donde);
   readln; 
 end.