Очередь, Слова из txt-файла в очередь Опции

[*alt]

Задача
Задан текстовый файл. Распечатать все слова максимальной длинны (с использованием очереди)

Вот мой код, но он не работает
Пока глупости много=))

Код

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;

  writeln('***********Обработка Завершена***********');
  readln;
end.

Помогите исправить и довести решение...

[volvo]

Во-первых,

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]

Код

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;

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 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;

  writeln('***********Îáðàáîòêà Çàâåðøåíà***********');
  readln;
end.

[b]Тест[b]
На Входе:: qqq wwww eeee rrr tt y uuuu
На Выходе: eeee uuuu

Не правильная Работа! Где Ошибка???

[volvo]

Замени SeekEof на Eof, и убедись, что в файле после слова uuuu идет перевод строки...

P.S. Блин... Что ж ты творишь? Я написал что надо делать - ты мало того, что неправильно сделал, так еще и меня обвинил!

           while queue_pop(q, m_s) do{ <--- удаляем содержимое очереди }
              queue_push(q, max_s); { <--- и закидываем в нее новое слово }

Это что за фигня???

Сообщение отредактировано: volvo - 19.03.2008 22:13