Pascal/Turbo Pascal - ayuda con este algoritmo de ordenacion

Publicidad
ENLACES PUBLICITARIOS



ADSL24h + llamadas
¡Ahora gratis hasta septiembre!
Y además llévate un obsequio



Gratis 5 de sus productos más populares, incluyendo tarjetas de visita, etiquetas e imanes. Sólo pagas los gastos de envío. ¡Aprovéchalas hoy!


Hola Pido ayuda con este algoritmo de ordenacion ya que pr alguna razon que desconozco no funciona correctamente

muchas gracias de antemano
Saludos

program MezclaNatural;

{$APPTYPE CONSOLE}

uses
SysUtils;

type
palabra=string [21];
tipofich=file of palabra;
var
f0:tipofich;
{proceure para ver el archivo}
procedure verfich(var f:tipofich);
var
pal:palabra;
pala:string;
begin
reset (f);
while not eof (f) do
begin
pal:=''; {}
repeat {}
read (f,pal);
if (pal<>'') then {}
pala:=pala+pal;
until(pal=' ')or(eof (f));{}
end;
write (pala,'');
close(f);
end;

function inspeccionar(var f:tipofich):palabra;
var
buf,pala:palabra;
pos:longint;
begin
pos:=filepos(f);
pala:=''; {}
repeat {}
read (f,buf);
if (buf<>' ') then {}
pala:=pala+buf;
until(buf='') or (eof(f))or (buf=#$D) or (buf=#$A);{}
seek(f,pos);
inspeccionar:=pala;
end;

procedure copiarpal (var fini,fdes:tipofich; var fintramo:boolean);
var
buf,pala:palabra;
begin
{pala:=''; {}
{repeat {}
read (fini,buf);
{ if (buf<>'') then {}
{ pala:=pala+buf;
{ until(buf=' ') or (eof(fini))or (buf=#$D) or (buf=#$A);{}
write(fdes,pala);
if eof(fini)then
fintramo:=true
else
begin
buf:=inspeccionar (fini);
fintramo:=pala<buf;
{if fintramo then write(pala,' < ',buf)
else write(pala,' > ',buf); }
end;
end;

procedure copiartramo (var fini,fdes:tipofich; var fintramo:boolean);
begin
repeat
copiarpal(fini,fdes,fintramo);
until fintramo;
end;
{distribuccion de los tramos }
procedure distribucion(var f0,f1,f2:tipofich; var fintramo:boolean);
begin
repeat
copiartramo(f0,f1,fintramo);
if not eof(f0) then
copiartramo(f0,f2,fintramo);
until eof(f0);
end;
{mezcla un tramo de f1 y f2 sobre f0}
procedure mezclatramo(var f0,f1,f2:tipofich;var fintramo:boolean);
begin
repeat
if inspeccionar(f1)<= inspeccionar(f2) then
begin
copiarpal(f1,f0,fintramo);
if fintramo then
copiartramo (f2,f0,fintramo);
end
else
begin
copiarpal(f2,f0,fintramo);
if fintramo then
copiartramo (f1,f0,fintramo);
end;
until fintramo;
end;
procedure mezcla (var f0,f1,f2:tipofich;var ntramos:integer;var fintramo:boolean);
begin
while ((not eof(f1)) and (not eof(f2))) do
begin
mezclatramo(f0,f1,f2,fintramo);
inc (ntramos);
end;
while not eof (f1) do
begin
copiartramo(f1,f0,fintramo);
inc (ntramos);
end;
while not eof (f2) do
begin
copiartramo(f2,f0,fintramo);
inc (ntramos);
end;
end;
procedure mezclaNatura(var f0:tipofich);
var
f1,f2:tipofich;
fintramo:boolean;
ntramos:integer;
begin
assign(f1,'g:\progII~1\pract-~1\quijot~1\aux1.pal');
assign(f2,'g:\progII~1\pract-~1\quijot~1\aux2.pal');
repeat
rewrite(f1);
rewrite(f2);
reset(f0);
distribucion(f0,f1,f2,fintramo);
{verfich (f1);readln;verfich (f2);readln;}
close(f0);close(f1);close(f2);
reset(f1);
reset(f2);
rewrite(f0);
ntramos:=0;
mezcla(f0,f1,f2,ntramos,fintramo);
close(f0); close(f1); close(f2);
until ntramos=1;
end;
begin
assign(f0,'g:\progII~1\pract-~1\quijot~1\quijote.pal');
verfich (f0);
mezclaNatura(f0);
verfich (f0);
readln;
end.