Организовать очереди по N элементов, создать файл слов по N символов в каждом - Free Pascal
Формулировка задачи:
Помогите пожалуйста с решением задачи на FreePascal по динамическим структурам
Имеется файл символьного типа. Организовать очереди по N элементов,создать файл слов по N символов в каждом.
Решение задачи: «Организовать очереди по N элементов, создать файл слов по N символов в каждом»
textual
Листинг программы
const
capacity = 100;
type
TData = Char;
TPElem = ^TElem;
TElem = record
Data: TData;
PNext: TPElem;
end;
TQueue = record
PFirst, PLast: TPElem;
end;
procedure QueueInit(var aQueue: TQueue);
begin
aQueue.PFirst := nil;
aQueue.PLast := nil;
end;
procedure QueuePush(var aQueue: TQueue; const aData: TData);
var
PElem: TPElem;
begin
New(PElem);
PElem^.Data := aData;
PElem^.PNext := nil;
if (aQueue.PFirst = nil)
then
aQueue.PFirst := PElem
else
aQueue.PLast^.PNext := PElem;
aQueue.PLast := PElem;
end;
function QueuePop(var aQueue: TQueue; var aData: TData): Boolean;
var
PElem: TPElem;
Result: Boolean;
begin
Result := False;
Result := (aQueue.PFirst <> nil);
if (Result)
then
begin
PElem := aQueue.PFirst;
aData := PElem^.Data;
aQueue.PFirst := PElem^.PNext;
if (aQueue.PFirst = nil)
then
aQueue.PLast := nil;
Dispose(PElem);
end;
QueuePop := Result;
end;
procedure QueueFree(var aQueue: TQueue);
var
Data: TData;
begin
while QueuePop(aQueue, Data) do;
end;
function QueueToStr(var aQueue : TQueue): String;
var
QTmp: TQueue;
Data: TData;
Result: String;
begin
if (aQueue.PFirst = nil)
then
begin
Result := 'Очередь пуста.';
Exit;
end;
Result := '';
QueueInit(QTmp);
while QueuePop(aQueue, Data) do
begin
QueuePush(QTmp, Data);
if (Result <> '')
then
Result := Result + ', ';
Result := Result + Data;
end;
aQueue := QTmp;
end;
var
f, g: File Of TData;
c: TData;
q: TQueue;
size, i, n: Word;
s: String;
begin
Assign(f, 'f.txt'); ReSet(f);
size := FileSize(f);
SetLength(s, size);
BlockRead(f, s[1], Size);
Close(f);
QueueInit(q);
Write('Input n='); ReadLn(n);
for i := 1 to size do
begin
if ((i > 1) And (i mod n = 1))
then
begin
QueuePush(q, #13);
QueuePush(q, #10);
end;
QueuePush(q, s[i]);
end;
size := 0;
while QueuePop(q, c) do
begin
Inc(size);
if (size > Length(s))
then
SetLength(s, size + capacity);
s[size] := c;
end;
Assign(g, 'g.txt'); ReWrite(g);
BlockWrite(g, s[1], size);
Close(g);
QueueFree(q);
end.