Задача: ввести N слов в массив, элементы массива записать в файл, отсортировать файл внешней сортировкой двупутевым слиянием по признаку - количество гласных буквв слове, поместить из файла отсортированные данные в массив, результат вывести на экран. Среда Borland Pascal 7.0.
Проблемы: Массив выводится лесенкой почему-то. Не могу понять почему.
| Код |
Program SortWorld;
Uses Crt;
Const
_FILE0_='file0.txt';
N=6; { number of words }
Type
TElem = record
name : string;
count: integer
end;
TFile = file of TElem;
TArray = array[1..N] of TElem;
TSequence= record
f : TFile;
elem : TElem;
eof,eor:boolean
end;
Var
File0 : TFile;
InputArray: TArray;
i : word;
Procedure Input;
var
buffer : char;
i,j : word;
begin
for i:=1 to N do
begin
write('Word #',i,': ');
j:=0; InputArray[i].name:='';
read(buffer);
while buffer <> #13 do
begin
IF buffer in ['A','a','E','e','I','i','O','o','U','u','Y','y']
then
inc(j);
InputArray[i].name:=InputArray[i].name+buffer;
read(buffer)
end;
InputArray[i].count:=j
end
end;
Procedure GetToFile;
var i :word;
buffer:TElem;
begin
assign(File0,_FILE0_);
rewrite(File0);
for i:=1 to N do
begin
buffer:=InputArray[i];
write(File0,buffer)
end;
close(File0)
end;
Procedure OutputFile;
var buffer:TElem;
i: word;
begin
assign(File0,_File0_);
reset(File0); i:=0;
while not eof(File0) do
begin
inc(i);
read(File0,InputArray[i])
end;
close(File0);
for i:=1 to N do
begin
write(InputArray[i].name,' - ',InputArray[i].count)
end
end;
Procedure OpenSeq(var s:TSequence; fn: string);
begin
assign(s.f,fn)
end;
Procedure ReadNext (var s:TSequence);
begin
s.eof:=eof(s.f);
if not s.eof then read(s.f,s.elem)
end;
Procedure StartRead(var s:TSequence);
begin
reset(s.f);
ReadNext(s);
s.eor:=s.eof
end;
Procedure StartWrite(var s:TSequence);
begin
rewrite(s.f)
end;
Procedure CloseSeq(var s:TSequence);
begin
close(s.f)
end;
Procedure Copy(var x,y:TSequence);
begin
y.elem:=x.elem;
write(y.f,y.elem);
ReadNext(x);
x.eor:=x.eof or (x.elem.count<y.elem.count)
end;
Procedure CopyRun(var x,y:TSequence);
begin
repeat
Copy(x,y)
until x.eor
end;
Procedure Distribute(var f0,f1,f2:TSequence);
begin
StartRead(f0); StartWrite(f1); StartWrite(f2);
while not f0.eof do
begin
CopyRun(f0,f1);
if not f0.eof then CopyRun(f0,f2)
end;
CloseSeq(f0); CloseSeq(f1); CloseSeq(f2)
end;
Procedure Marge(var f0,f1,f2:TSequence; var count:integer);
begin
StartRead(f1); StartRead(f2); StartWrite(f0);
count:=0;
while not f1.eof and not f2.eof do
begin
while not f1.eor and not f2.eor do
if f1.elem.count<=f2.elem.count
then
Copy(f1,f0)
else
Copy(f2,f0);
if not f1.eor then CopyRun(f1,f0);
if not f2.eor then CopyRun(f2,f0);
f1.eor:=f1.eof;
f2.eor:=f2.eof;
inc(count)
end;
while not f1.eof do
begin
CopyRun(f1,f0);
inc(count)
end;
while not f2.eof do
begin
CopyRun(f2,f0);
inc(count)
end;
CloseSeq(f1); CloseSeq(f2); CloseSeq(f0)
end;
Procedure Sort(FileName: string);
var
f0,f1,f2:TSequence;
count:integer;
begin
OpenSeq(f0,filename); OpenSeq(f1,'temp1'); OpenSeq(f2,'temp2');
repeat
Distribute(f0,f1,f2);
Marge(f0,f1,f2,count)
until count <=1;
Erase(f1.f); Erase(f2.f)
end;
Begin
ClrScr;
Input;
GetToFile;
ClrScr;
writeln('Before sorting:');
OutputFile;
Sort(_File0_);
writeln; writeln('After sorting:');
OutputFile;
Erase(File0);
readln
End.
|
|
)