Задача Задан текстовый файл. Распечатать все слова максимальной длинны (с использованием очереди)
Вот мой код, но он не работает Пока глупости много=))
Код
type TElem = string; Tptr = ^Tlist; Tlist = record inf: Telem; next: tptr; end; TQueue = record head, tail: Tptr; end; var q: TQueue; //очередь f: text; m_s,max_s,name: string; s:char; ok:boolean; {инициализация очереди} procedure queue_init (var q: Tqueue); begin q.head:=nil; end;
{проверка на пустоту} function queue_empty (var q: tqueue): boolean; begin queue_empty:=q.head=nil; end;
{добавление в очередь} procedure queue_push (var q: tqueue; var el: Telem); var p: Tptr; begin new(p); p^.inf:=el; if queue_empty (q) then q.head:=p else q.tail^.next:=p; q.tail:=p; end;
{изъятие из очереди} function queue_pop (var q:Tqueue; var el:Telem): boolean; var p: Tptr; begin if queue_empty (q) then queue_pop:=false else begin queue_pop:=true; el:=q.head^.inf; p:=q.head; q.head:=q.head^.next; dispose(p); end; end;
begin{main}
writeln ('Введите имя файла (имя.txt)'); read(name); assign(f, name); reset(f); queue_init(q);
{добавление в очередь} while not eof(f) do begin m_s:=''; ok:=true; while ok or eof(f) do begin read(f, s); if s=' ' then ok:=false; m_s:=m_s+s; end; if length(m_s)>=length(max_s) then begin max_s:=m_s; queue_push(q, max_s); end; end; readln; close(f);
assign(f, 'out_text.txt'); rewrite(f);
while not queue_empty(q) do begin queue_pop (q,m_s); if m_s=max_s then write (f, m_s); end; close(f); readln;
procedure queue_push (var q: tqueue; var el: Telem); var p: Tptr; begin new(p); p^.inf:=el; p^.next := nil; { <--- !!! } ...
. Во-вторых,
while not seekeof(f) do begin m_s:=''; ok := true; while ok and (not seekeof(f)) do begin { <--- AND, а не OR } read(f, s); if s in [' ', #10, #13] then ok:=false { <--- Другие разделители добавишь сам } else m_s := m_s + s; end;
if length(m_s)>length(max_s) then begin { <--- Более длинное слово чем было... } max_s:=m_s; while queue_pop(q, m_s) do; { <--- удаляем содержимое очереди } queue_push(q, max_s); { <--- и закидываем в нее новое слово } end else if length(m_s) = length(max_s) then queue_push(q, m_s); { <--- Добавляем слово той же длины } end;
Ну, и в третьих - вывод:
while not queue_empty(q) do begin queue_pop (q,m_s); writeln(f, m_s); { <--- Не надо никаких условий, выводишь все содержимое... } end;
Автор: *alt 20.03.2008 1:56
Код
type TElem = string; Tptr = ^Tlist; Tlist = record inf: Telem; next: tptr; end; TQueue = record head, tail: Tptr; end; var q: TQueue; //î÷åðåäü f: text; m_s,max_s,name: string; s:char; ok:boolean; {èíèöèàëèçàöèÿ î÷åðåäè} procedure queue_init (var q: Tqueue); begin q.head:=nil; end;
{ïðîâåðêà íà ïóñòîòó} function queue_empty (var q: tqueue): boolean; begin queue_empty:=q.head=nil; end;
{äîáàâëåíèå â î÷åðåäü} procedure queue_push (var q: tqueue; var el: Telem); var p: Tptr; begin new(p); p^.inf:=el; p^.next := nil; if queue_empty (q) then q.head:=p else q.tail^.next:=p; q.tail:=p; end;
{èçúÿòèå èç î÷åðåäè} function queue_pop (var q:Tqueue; var el:Telem): boolean; var p: Tptr; begin if queue_empty (q) then queue_pop:=false else begin queue_pop:=true; el:=q.head^.inf; p:=q.head; q.head:=q.head^.next; dispose(p); end; end;
{äîáàâëåíèå â î÷åðåäü} while not eof(f) do begin m_s:=''; ok := true; while ok and (not eof(f)) do begin read(f, s); if s in [' ', #10, #13] then ok:=false else m_s := m_s + s; end;
if length(m_s)>length(max_s) then begin { <--- Áîëåå äëèííîå ñëîâî ÷åì áûëî... } max_s:=m_s; while queue_pop(q, m_s) do{ <--- óäàëÿåì ñîäåðæèìîå î÷åðåäè } queue_push(q, max_s); { <--- è çàêèäûâàåì â íåå íîâîå ñëîâî } end else if length(m_s) = length(max_s) then queue_push(q, m_s); { <--- Äîáàâëÿåì ñëîâî òîé æå äëèíû } end;
readln; close(f);
assign(f, 'out_text.txt'); rewrite(f);
while not queue_empty(q) do begin queue_pop (q,m_s); writeln(f, m_s); end; close(f); readln;