{ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
 º TDA COLA – SIMPLE Y CIRCULAR      º
 º Desarrollado por: H. Vivani.      º
 º Universidad CAECE – Mar del Plata º
 º 16/10/2000                        º
 ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
}
unit cola;

INTERFACE
const
   maxcola=50;
type
   telemento=char;
   tcola=record
      pri,ult:0..maxcola;
      items:array[1..maxcola] of telemento;
   end;

procedure IniciaC(var c:tcola);
function VaciaC(c:tcola):boolean;
function LlenaC(c:tcola):boolean;
procedure SacaC(var c:tcola;var elemc:telemento);
procedure PoneC(var c:tcola;elemc:telemento);
procedure ConsultaC(c:tcola; var elemc:telemento);

IMPLEMENTATION

procedure IniciaC;
begin
   c.pri:=0;
   c.ult:=0;
end;

function VaciaC;
begin
   VaciaC:=c.pri=0;
end;

{function LlenaC;
begin
   Llenac:=c.ult=maxcola;
end;}

function LlenaC;                        {CIRCULAR}
begin
   LlenaC:=((c.ult=maxcola) and (c.pri=1)) or (c.ult+1=c.pri);
end;

{procedure SacaC;
begin
   if not VaciaC(c) then
   begin
      elemc:=c.items[c.pri];
      if c.pri=c.ult then       {cuando la cola tiene un £nico elemento}
{         iniciac(c)
      else
         c.pri:=c.pri+1;
   end;
end;}

procedure SacaC;                        {CIRCULAR}
begin
   if not VaciaC(c) then
   begin
      elemc:=c.items[c.pri];
      if c.pri=c.ult then       {cuando la cola tiene un £nico elemento}
         iniciac(c)
      else
         if c.pri=maxcola then
            c.pri:=1
         else
            c.pri:=c.pri+1;
   end;
end;

{procedure PoneC;
begin
   if not LlenaC(c) then
   begin
      c.ult:=c.ult+1;
      c.items[c.ult]:=elemc;
      if c.pri=0 then           {si es el primer elemento}
{         c.pri:=1;
   end;
end;}

procedure PoneC;                        {CIRCULAR}
begin
   if not LlenaC(c) then
   begin
      if c.ult=maxcola then
         c.ult:=1               {continuo en el principio}
      else
         c.ult:=c.ult+1;
      c.items[c.ult]:=elemc;
      if c.pri=0 then           {si es el primer elemento}
         c.pri:=1;
   end;
end;

procedure ConsultaC;
begin
   if not VaciaC(c) then
      elemc:=c.items[c.pri];
end;

end.

{ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
 º TDA PILA – en memoria estatica    º
 º Desarrollado por: H. Vivani.      º
 º Universidad CAECE – Mar del Plata º
 º 11/10/2000                        º
 ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
}
unit pila;

INTERFACE
const
   maxpila=50;
type
   telemento=char;
   tpila=record
      items:array [1..maxpila] of telemento;
      tope:0..maxpila;                        {0 para vacia}
   end;

procedure IniciaP(var p:tpila);
function VaciaP(p:tpila):boolean;
function LlenaP(p:tpila):boolean;
procedure SacaP(var p:tpila; var elemp:telemento);
procedure PoneP(var p:tpila; elemp:telemento);
procedure ConsultaP(p:tpila; var elemp:telemento);

IMPLEMENTATION

procedure IniciaP;
begin
   p.tope:=0;
end;

function VaciaP;
begin
   VaciaP:=p.tope=0;
end;

function LlenaP;
begin
   LlenaP:=p.tope=maxpila;
end;

procedure SacaP;
begin
   if not VaciaP(p) then
   begin
      elemp:=p.items[p.tope];
      p.tope:=p.tope-1;
   end;
end;

procedure PoneP;
begin
   if not LlenaP(p) then
   begin
      p.tope:=p.tope+1;
      p.items[p.tope]:=elemp;
   end;
end;

procedure ConsultaP;
begin
   if not vaciaP(p) then
      elemp:=p.items[p.tope];
end;

end.

{ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
 º TDA LISTA – en memoria estatica   º
 º Desarrollado por: H. Vivani.      º
 º Universidad CAECE – Mar del Plata º
 º 11/10/2000                        º
 ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
}

unit lista;

INTERFACE
const
   maxlista=50;
type
   telemento=string;
   tlista=record
      items:array[1..maxlista] of telemento;
      cant,act:0..maxlista;
   end;

procedure IniciaL(var l:tlista);{prepara la lista para comenzar a operar}
function VaciaL(l:tlista):boolean;{verifica si est  vac¡a}
function LlenaL(l:tlista):boolean;{verifica si est  llena}
procedure PrimeroL(var l:tlista);{se posiciona al comienzo de la lista}
procedure SiguienteL(var l:tlista);{avanza al siguiente nodo de la lista}
function FinL(l:tlista):boolean;{verifica si se alcanz¢ el final de la lista}
procedure InsertaL(var l:tlista;eleml:telemento);{inserta en orden ascendente}
{procedure IncertaPpioL(var l:tlista;eleml:telemento);{inserta al principio}
{procedure InsertaFinL(var l:tlista;eleml:telemento);{inserta al final}
{procedure InsertaNL(var l:tlista;eleml:telemento;N:byte);{inserta en la N-‚sima posici¢n}
{procedure EliminaPpioL(var l:tlista);{elimia el primer noo de la lista}
{procedure EliminaL(var l:tlista);{elimina el nodo actual y avanza al siguiente}

procedure InfoL(l:tlista; var eleml:telemento);
procedure ModificaL(var l:tlista; eleml:telemento);

IMPLEMENTATION

procedure IniciaL;
begin
   l.cant:=0;
   l.act:=0;
end;

function VaciaL;
begin
   VaciaL:=l.cant=0;
end;

function LlenaL;
begin
   LlenaL:=l.cant=maxlista;
end;

procedure PrimeroL;
begin
   l.act:=1;
end;

procedure SiguienteL;
begin
   if not LlenaL(l) then
      l.act:=l.act+1;
end;

function FinL;  {detecta el fin despues de haber pasado el £ltimo (EOF)}
begin
   FinL:=l.act=l.cant+1;
end;

procedure InsertaL;     {inserta ordenado}
var
   j:0..maxlista;
begin
   if not LlenaL(l) then
   begin
      j:=l.cant;{corro los elementos desde el final h/encontrar la posicion}
      while (j>0) and (l.items[j]>eleml) do
      begin
         l.items[j+1]:=l.items[j];
         j:=j-1;
      end;
      l.items[j+1]:=eleml;      {inserto}
      l.cant:=l.cant+1;         {incremento la cantidad de elmentos}
   end;
end;

procedure InfoL;
begin
   if l.act>0 then
      eleml:=l.items[l.act];
end;

procedure ModificaL;
begin
   if l.act0 then
      l.items[l.act]:=eleml;
end;

end.

Algoritmos de ordenación clásicos. Métodos Burbuja, Inserción y Selección.

TDA en Pascal

{ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ» 
 º TDA ORDENA - Algoritmos de        º 
 º ordenacion                        º 
 º Desarrollado por: H. Vivani.      º 
 º Universidad CAECE - Mar del Plata º 
 º 25/08/2000                        º 
 ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ 
}
unit ordena;
interface                       {PARTE PUBLICA}
const 
   max=100; 
type 
   tipo=integer; 
   tvector=array [1..max] of tipo;

procedure burbuja (var vector:tvector;n:byte); 
procedure insercion(var vector:tvector;n:byte); 
procedure seleccion(var vector:tvector;n:byte);

implementation                  {PARTE PRIVADA}

procedure burbuja; 
var 
   i,final,intercambio:byte; 
   aux:tipo; 
begin 
   final:=n; 
   intercambio:=1; 
   while intercambio 0 do 
   begin 
      intercambio:=0; 
      for i:=1 to final-1 do 
      begin 
         if (vector[i]>vector[i+1]) then 
         begin 
            aux:=vector[i]; 
            vector[i]:=vector[i+1]; 
            vector[i+1]:=aux; 
            intercambio:=i; 
         end; 
      end; 
      final:=intercambio; 
   end; 
end;

procedure insercion; 
var 
   i,j:byte; 
   aux:tipo; 
begin 
   for i:= 2 to n do 
   begin 
      aux:=vector[i]; 
      j:=i-1; 
      while (j>0) and (aux<vector[j]) do 
      begin 
         vector[j+1]:=vector[j]; 
         j:=j-1; 
      end; 
      vector[j+1]:=aux; 
   end; 
end;

procedure seleccion; 
var 
   i,j,minimo:byte; 
   aux:tipo; 
begin 
   for i:=1 to n-1 do 
   begin 
      minimo:=i; 
      for j:=i+1 to n do 
         if vector[j]<vector[minimo] then 
            minimo:=j; 
      aux:=vector[i]; 
      vector[i]:=vector[minimo]; 
      vector[minimo]:=aux; 
   end; 
end;

end.

{ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
 º TDA FECHAS – Unit para el manejo  º
 º de fechas.                        º
 º Desarrollado por: H. Vivani.      º
 º Universidad CAECE – Mar del Plata º
 º 11/09/2000                        º
 ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
}

unit fechas;

INTERFACE
uses
   dos;
type
   str10=string[10];
   tfecha=record
      anio:word;
      mes:byte;
      dia:byte;
   end;
   mes=array[0..1,1..12] of word;
   semana=array[0..6] of str10;

const
   dias:mes=((0,31,59,90,120,151,181,212,243,273,304,334),(0,31,60,91,121,152,182,213,244,274,305,335));
   diasem:semana=(‘Domingo’,’Lunes’,’Martes’,’Miercoles’,’Jueves’,’Viernes’,’Sabado’);

procedure LeeFecha(var f:tfecha);        {Ingresa una fecha desde el teclado}
procedure EscribeFecha(f:tfecha);        {Escribe la fecha}
function ObtMes(f:tfecha):byte;          {Obtengo el mes}
function ObtAnio(f:tfecha):word;         {Obtengo el a€o}
function ObtDia(f:tfecha):byte;          {Obtengo el d¡a}
function Bisiesto(f:tfecha):boolean;     {Analizo si es bisiesto}
function FechaValida(f:tfecha):boolean;  {Verifico si es valida la fecha}
function CantDias(f1,f2:tfecha):word;    {Obtengo cantidad de dias e/fechas}
function CantAnios(f1,f2:tfecha):word;   {Obtengo cantidad de anios e/fechas}
procedure FechaFinal(f1:tfecha; dd:word;var f2:tfecha); {Obtengo fecha a dd dias}
function DiaSemana(f:tfecha):str10;      {Obtengo el dia de la semana}
function FechaMayor(f1,f2:tfecha):boolean;{Determino si la 1er fecha es > que la 2da}
procedure Obtfsys(var f:tfecha);         {Obtengo la fecha del sistema}

IMPLEMENTATION

procedure leefecha;
begin
   write(‘A€o? ‘);readln(f.anio);
   write(‘Mes? ‘);readln(f.mes);
   write(‘D¡a? ‘);readln(f.dia);
end;

procedure escribefecha;
begin
   writeln(‘A€o? ‘,f.anio);
   writeln(‘Mes? ‘,f.mes);
   writeln(‘D¡a? ‘,f.dia);
end;

function obtmes;
begin
   obtmes:=f.mes;
end;

function obtanio;
begin
   obtanio:=f.anio;
end;

function obtdia;
begin
   obtdia:=f.dia;
end;

function Bisiesto;
begin
   if (f.anio mod 4=0) and ((f.anio mod 1000) or (f.anio mod 400=0)) then
      Bisiesto:=true
   else
      Bisiesto:=false;
end;

function ObtIndBis(f:tfecha):byte;       {Obtengo el indice del arreglo}
begin
   if bisiesto(f) then
      obtindbis:=1
   else
      obtindbis:=0;
end;

function ObtDiasMes(f:tfecha):byte;      {Obtengo cantidad de dias del mes}
var
   ind:byte;
begin
   ind:=obtindbis(f);
   if f.mes=12 then
      obtdiasmes:=365+ind-dias[ind,f.mes]        {verifico si es valido el dia}
   else
      if f.mes=1 then
         obtdiasmes:=31
      else
         obtdiasmes:=dias[ind,f.mes+1]-dias[ind,f.mes];
end;

function fechavalida;
var
   d,ind:byte;
   dd,mm:boolean;
begin
   ind:=obtindbis(f);
   if (f.mes>=1) and (f.mes<=12) then       {verifico si es valido el mes}
   begin
      mm:=true;
      if f.dia<=obtdiasmes(f) then
         dd:=true
      else
         dd:=false;
   end
   else
   begin
      mm:=false;
   end;

   if (f.anio>1900) and (dd=true) and (mm=true) then
      fechavalida:=true
   else
      fechavalida:=false;
end;

function BisiestoW(anio:word):boolean;{comprueba si el anio(word) es bisiesto}
begin
   if (anio mod 4=0) and ((anio mod 1000) or (anio mod 400=0)) then
      BisiestoW:=true
   else
      BisiestoW:=false;
end;

function cantdias;
var
   i1,i2:byte;
   d1,d2:word;
   i,acu:word;
begin
   acu:=0;
   i1:=obtindbis(f1);
   i2:=obtindbis(f2);
   d1:=dias[i1,f1.mes]+f1.dia;
   d2:=dias[i2,f2.mes]+f2.dia;
   if f1.anio=f2.anio then
   begin
      if d1<d2 then
         cantdias:=d2-d1
      else
         cantdias:=d1-d2;
   end
   else
   begin
      if f1.anio<f2.anio then
      begin
         for i:=f1.anio to f2.anio-1 do       {acumulo los dias de los anios}
         begin
            if bisiestow(i)=true then
               acu:=acu+366
            else
               acu:=acu+365;
         end;
         cantdias:=(acu)-d1+d2;
      end
      else
      begin
         for i:=f1.anio-1 downto f2.anio do   {acumulo los dias de los anios}
         begin
            if bisiestow(i)=true then
               acu:=acu+366
            else
               acu:=acu+365;
         end;
         cantdias:=(acu)+d1-d2;
      end
   end
end;

function Cantanios;
begin
   cantanios:=cantdias(f1,f2) div 365;
end;

procedure FechaFinal;        {VALIDA PARA +365 dias}
var
   ind,i,dia:byte;
   d1,d2,anio:word;
begin
   ind:=obtindbis(f1);                  {obtengo el indice del arreglo}
   d1:=dias[ind,f1.mes]+f1.dia+dd;      {acumulo el total de dias}
   writeln(‘acumulado de dias: ‘,d1);
   if d1<(365+ind) then                 {si no supero el anio actual}
   begin
      i:=f1.mes;
      while d1 > dias[ind,i] do         {busco el mes en el arreglo}
         i:=i+1;
      dia:=d1-dias[ind,i-1];
      f2.anio:=f1.anio;
      f2.mes:=i-1;
      f2.dia:=dia;
   end
   else
   begin
      d2:=d1-(365+ind);
      writeln(‘acumulado de dias 2: ‘,d2);
      i:=1;
      while d2 > dias[ind,i] do         {busco el mes en el arreglo}
         i:=i+1;
      dia:=d2-dias[ind,i-1];
      f2.anio:=f1.anio+1;
      f2.mes:=i-1;
      f2.dia:=dia;
   end
end;

function diasemana;
var
   fbase:tfecha;
begin
   fbase.dia:=06;
   fbase.mes:=01;
   fbase.anio:=1980;
   diasemana:=diasem[cantdias(fbase,f) mod 7];
end;

function fechamayor;
var
   ind1,ind2:byte;
   d1,d2:word;
begin
   ind1:=obtindbis(f1);
   ind2:=obtindbis(f2);
   d1:=dias[ind1,f1.mes]+f1.dia;
   d2:=dias[ind2,f2.mes]+f2.dia;
   if obtanio(f1)>obtanio(f2) then
      fechamayor:=true
   else
      if obtanio(f1)<obtanio(f2) then
         fechamayor:=false
      else
      begin
         if d1>d2 then
            fechamayor:=true
         else
            fechamayor:=false;
      end;
end;

procedure obtfsys;
var
   y,m,d,dow:word;     {en dow tengo el dia de la semana 0..6}
begin
   GetDate(y,m,d,dow);
   f.anio:=y;
   f.mes:=m;
   f.dia:=d
end;

end.