Unit escrita en Pascal con algunas operaciones sobre arrays
{ ----------------------------------------------------------------}
{ AUTOR: D'ACHARY Vladimiro Gaston }
{ fecha: 30/12/2013 }
{ Unidad PASCAL operaciones basicas sobre arrays unidimensionales }
{-----------------------------------------------------------------}
unit untArrays;
{$mode objfpc}{$H+}
interface
uses crt;
const
MAX = 5;
type
RArr = record
cod:integer;
nom:string[15];
rel:string[15];
ed :byte;
end;
TArr = array [1..MAX] of RArr;
function len(elArray:TArr):byte;
function buscarPos(elArray:TArr; target:string):byte;
function buscarBool(elArray:TArr; target:string):boolean;
procedure inicializarRegistro(var reg:RArr);
procedure agregarArr(var elArray:TArr; reg:RArr);
procedure forzarEnArr(var elArray:TArr; reg:RArr; pos:byte);
procedure insertarArr(var elArray:TArr; reg;RArr; pos:byte);
procedure buscarInsertar(var elArray:TArr; reg:RArr; target:string);
procedure buscarInsertarOrd(var elArray:TArr; reg:RArr; cod:integer);
procedure ordenarBurbujeo(var elArray:TArr);
procedure apilar(var elArray:TArr; reg:RArr);
procedure desApilar(var elArray; reg:RArr);
procedure encolar(var elArray:TArr; reg:RArr);
procedure desEncolar(var elArray:TArr);
implementation
function len(elArray:TArr):byte;
var
i:byte;
begin
i:=1;
while ( i<=MAX ) and ( elArray[i].cod>0 ) do begin
i:=i+1
end;
len:=i;
end;
function buscarPos(elArray:TArr; target:string):byte;
var
i:byte;
begin
i:=1;
while ( i<=MAX ) and ( elArray[i].nom<>target ) do begin
i:=i+1
end;
if ( elArray[i]=target ) then begin
buscarPos:=i
end else begin
buscarPos:=0
end
end;
function buscarBool(elArray:TArr; target:string):boolean;
var
existe:boolean;
i:byte;
begin
i:=1;
existe:=false;
while ( i<=MAX ) and ( existe=false ) do begin
if ( elArray[i].nom=target ) then begin
existe:=true
end;
i:=i+1
end;
buscarBool:=existe;
end;
procedure inicializarRegistro(var reg:RArr);
begin
reg.cod:=0;
reg.nom:='';
reg.rel:='';
reg.ed:=0;
end;
procedure agregarArr(var elArray:TArr; reg:RArr);
var
i:byte;
begin
i:=1;
while ( i<=MAX ) and ( elArray[i].cod>0 ) do begin
i:=i+1
end;
elArray[i]:=reg
end;
procedure forzarEnArr(var elArray:TArr; reg:RArr; pos:byte);
begin
if ( pos<=MAX ) and ( pos>0 ) then begin
elArray[pos]:=reg
end;
end;
procedure insertarArr(var elArray:TArr; reg;RArr; pos:byte);
var
i:byte;
begin
for i:=len(elArray) downTo pos do begin
elArray[i+1]:=elArray[i]
end;
elArray[pos]:=reg;
end;
procedure buscarInsertar(var elArray:TArr; reg:RArr; target:string; pos:byte);
begin
if ( buscarBool(elArray,target)=false ) then begin
insertarArr(elArray,reg,pos)
end;
end;
procedure buscarInsertarOrd(var elArray:TArr; reg:RArr; cod:integer);
var
i:byte;
begin
if ( buscarBool(elArray,cod)=false ) then begin
i:=i+1;
while ( i<=MAX ) and ( elArray[i].cod<cod ) then begin
i:=i+1;
end;
insertarArr(elArray,reg,i);
end;
end;
procedure eliminarArr(var elArray:TArr; target:string);
var
i:byte;
pos:byte;
aux:RArr;
begin
pos:=buscarPos(elArray,target);
if ( pos<>0 ) then begin
for i:=pos to len(elArray) do begin
elArray[pos]:=elArray[pos+1];
end;
elArray[len(elArray)]:=elArray[len(elArray)+1];
end;
end.
procedure ordenarBurbujeo(var elArray:TArr);
var
i,ii,largo:byte;
aux:RArr;
begin
largo:=len(elArray);
for i:=1 to largo-1 do begin
for ii:=1 to largo do begin
if elArray[ii].cod>elArray[ii+1] then begin
aux:=elArray[ii];
elArray[ii]:=elArray[ii+1];
elArray[ii+1]:=aux;
end;
end;
end;
end.
procedure apilar(var elArray:TArr; reg:RArr);
begin
if ( len(elArray)<MAX ) then begin
agregarArr(elArray,reg);
end;
end;
procedure desEnpilar(var elArray:TArr);
var
ultimo:byte;
aux:RArr
begin
ultimo:=len(elArray);
inicializarRegistro(aux);
elArray[ultimo]:=aux;
end;
procedure encolar(var elArray:TArr; reg:RArr);
begin
if ( len(elArray)<MAX ) then begin
agregarArr(elArray,reg);
end;
end;
procedure desEncolar(var elArray:TArr);
var
i:byte;
aux:RArr;
begin
i:=1;
for i:=1 to len(elArray) do begin
elArray[i]:=elArray[i+1];
end;
inicializarRegistro(aux);
elArray[len(elArray)):=aux;
end;
end.
{ AUTOR: D'ACHARY Vladimiro Gaston }
{ fecha: 30/12/2013 }
{ Unidad PASCAL operaciones basicas sobre arrays unidimensionales }
{-----------------------------------------------------------------}
unit untArrays;
{$mode objfpc}{$H+}
interface
uses crt;
const
MAX = 5;
type
RArr = record
cod:integer;
nom:string[15];
rel:string[15];
ed :byte;
end;
TArr = array [1..MAX] of RArr;
function len(elArray:TArr):byte;
function buscarPos(elArray:TArr; target:string):byte;
function buscarBool(elArray:TArr; target:string):boolean;
procedure inicializarRegistro(var reg:RArr);
procedure agregarArr(var elArray:TArr; reg:RArr);
procedure forzarEnArr(var elArray:TArr; reg:RArr; pos:byte);
procedure insertarArr(var elArray:TArr; reg;RArr; pos:byte);
procedure buscarInsertar(var elArray:TArr; reg:RArr; target:string);
procedure buscarInsertarOrd(var elArray:TArr; reg:RArr; cod:integer);
procedure ordenarBurbujeo(var elArray:TArr);
procedure apilar(var elArray:TArr; reg:RArr);
procedure desApilar(var elArray; reg:RArr);
procedure encolar(var elArray:TArr; reg:RArr);
procedure desEncolar(var elArray:TArr);
implementation
function len(elArray:TArr):byte;
var
i:byte;
begin
i:=1;
while ( i<=MAX ) and ( elArray[i].cod>0 ) do begin
i:=i+1
end;
len:=i;
end;
function buscarPos(elArray:TArr; target:string):byte;
var
i:byte;
begin
i:=1;
while ( i<=MAX ) and ( elArray[i].nom<>target ) do begin
i:=i+1
end;
if ( elArray[i]=target ) then begin
buscarPos:=i
end else begin
buscarPos:=0
end
end;
function buscarBool(elArray:TArr; target:string):boolean;
var
existe:boolean;
i:byte;
begin
i:=1;
existe:=false;
while ( i<=MAX ) and ( existe=false ) do begin
if ( elArray[i].nom=target ) then begin
existe:=true
end;
i:=i+1
end;
buscarBool:=existe;
end;
procedure inicializarRegistro(var reg:RArr);
begin
reg.cod:=0;
reg.nom:='';
reg.rel:='';
reg.ed:=0;
end;
procedure agregarArr(var elArray:TArr; reg:RArr);
var
i:byte;
begin
i:=1;
while ( i<=MAX ) and ( elArray[i].cod>0 ) do begin
i:=i+1
end;
elArray[i]:=reg
end;
procedure forzarEnArr(var elArray:TArr; reg:RArr; pos:byte);
begin
if ( pos<=MAX ) and ( pos>0 ) then begin
elArray[pos]:=reg
end;
end;
procedure insertarArr(var elArray:TArr; reg;RArr; pos:byte);
var
i:byte;
begin
for i:=len(elArray) downTo pos do begin
elArray[i+1]:=elArray[i]
end;
elArray[pos]:=reg;
end;
procedure buscarInsertar(var elArray:TArr; reg:RArr; target:string; pos:byte);
begin
if ( buscarBool(elArray,target)=false ) then begin
insertarArr(elArray,reg,pos)
end;
end;
procedure buscarInsertarOrd(var elArray:TArr; reg:RArr; cod:integer);
var
i:byte;
begin
if ( buscarBool(elArray,cod)=false ) then begin
i:=i+1;
while ( i<=MAX ) and ( elArray[i].cod<cod ) then begin
i:=i+1;
end;
insertarArr(elArray,reg,i);
end;
end;
procedure eliminarArr(var elArray:TArr; target:string);
var
i:byte;
pos:byte;
aux:RArr;
begin
pos:=buscarPos(elArray,target);
if ( pos<>0 ) then begin
for i:=pos to len(elArray) do begin
elArray[pos]:=elArray[pos+1];
end;
elArray[len(elArray)]:=elArray[len(elArray)+1];
end;
end.
procedure ordenarBurbujeo(var elArray:TArr);
var
i,ii,largo:byte;
aux:RArr;
begin
largo:=len(elArray);
for i:=1 to largo-1 do begin
for ii:=1 to largo do begin
if elArray[ii].cod>elArray[ii+1] then begin
aux:=elArray[ii];
elArray[ii]:=elArray[ii+1];
elArray[ii+1]:=aux;
end;
end;
end;
end.
procedure apilar(var elArray:TArr; reg:RArr);
begin
if ( len(elArray)<MAX ) then begin
agregarArr(elArray,reg);
end;
end;
procedure desEnpilar(var elArray:TArr);
var
ultimo:byte;
aux:RArr
begin
ultimo:=len(elArray);
inicializarRegistro(aux);
elArray[ultimo]:=aux;
end;
procedure encolar(var elArray:TArr; reg:RArr);
begin
if ( len(elArray)<MAX ) then begin
agregarArr(elArray,reg);
end;
end;
procedure desEncolar(var elArray:TArr);
var
i:byte;
aux:RArr;
begin
i:=1;
for i:=1 to len(elArray) do begin
elArray[i]:=elArray[i+1];
end;
inicializarRegistro(aux);
elArray[len(elArray)):=aux;
end;
end.
Comentarios
Publicar un comentario