Неверный ответ на задание Г главы 53 ("глупый" винчестер)

[viktorf9]

Добрый день! Спасибо большое за книгу. Начал по ней учиться программировать.
В ответах на задания неверно решена задача Г из главы 53 "Глупый винчестер". Если, конечно, я ничего не перепутал. Проверяется очень просто.
Пишем текстовой файл из двух строк - в 1-ой строке число 20 (тайм-аут), во 2-ой строке число 100.
Программа выдает ответ 97, хотя, очевидно, что правильный ответ 101 (100 перемещений + 1 чтение).
Ошибка связана с тайм-аутом. Чем он меньше, тем больше отклонение.

[Oleg_D]

Уважаемый victor, спасибо вам за похвальную въедливость. Но мне не удалось обнаружить ошибку: программа выдаёт 101, как и положено.
Может быть пришлёте мне тот вариант, который выдаёт столь странный ответ?

[viktorf9]

Сейчас еще раз скопировал код из Ответов в программу. Выдает 97. Редакция Ответов - 12.5
В коде менял только название исходного файла - вместо Disk.in указал p_53_d.txt

Вот код из программы (к сожалению, отступы при копировании сохранить не получается):

var F: Text; { входной файл,
в первой строке - период опроса входной очереди,
в последующих - списки запросов }
Period: integer; { период опроса входной очереди }
TimeOut: integer; { таймаут чтения входной очереди }
Track: integer; { текущий запрос из внутренней очереди }
Position: integer; { текущая позиция головки }
ProgramResult: integer; { общее время работы программы }
{----------------------------------------------------------}
{ Постановка в очередь и извлечение из нее }
var Que: string; { очередь }
procedure PutInQue(aTrack: integer); { Постановка в очередь }
begin
Que:= Que + Char(aTrack); { добавляем в конец строки}
end;
function GetFromQue: integer; { Выбор из очереди }
begin
if Length(Que) = 0 { если очередь пуста }
then GetFromQue:= -1
else begin
GetFromQue:= Ord(Que[1]); { возвращаем первый элемент }
Delete (Que, 1, 1); { и удаляем его из очереди }
end
end;
{----------------------------------------------------------}
{ Проверка истечения таймаута
и чтение очередной порции запросов из строки файла }
procedure TimeOutHandler;
var N: integer;
begin
if TimeOut>0 then begin
Inc(ProgramResult); { общее время }
Dec(TimeOut);
end
else begin
TimeOut:= Period;
{ Если истек таймаут, читаем порцию из файла }
if not EoF(F) then begin
while not Eoln(F) do begin
Read(F, N);
PutInQue(N)
end;
Readln(F);
end;
end;
end;
{----------------------------------------------------------}
{ Обработка запроса на чтение-запись дорожки }
procedure QueryHandler (aTrack: integer);
begin
{ Write(aTrack:4); }
{ продвигаем головку в требуемую позицию }
while Position<>aTrack do begin
if Position<aTrack
then Inc(Position)
else Dec(Position);
TimeOutHandler; { таймаут чтения из файла }
end;
{ Один квант тратим на чтение-запись }
TimeOutHandler; { таймаут чтения из файла }
end;
{----------------------------------------------------------}
begin { Main }
ProgramResult:=0; { Общее время }
Position:=0; { позиция головки }
TimeOut:= 0; { таймаут }
Que:=''; { внутренняя очередь пуста }
Assign(F, 'p_53_d.txt'); Reset(F);
Readln(F,Period); { в первой строке - период опроса очереди }
repeat
Track:= GetFromQue; { извлекаем из внутр. очереди }
if Track>0
then QueryHandler(Track) { выполнить запрос }
else if Eof(F) { если входной файл пуст }
then Break { то выход }
else TimeOutHandler;{ а иначе отрабатываем таймаут
и читаем строку файла }
until false;
Write('Result= ',ProgramResult); Readln;
end.

Файл p_53_d.txt

20
100

Еще раз спасибо за книгу. Это просто потрясающе!

[Oleg_D]

Да, действительно в файле с ответами оказалась устаревшая ошибочная версия программы.
Вчера я проверял код, лежащий в моих исходниках, и потому не заметил ошибки, ниже дана правильная версия (ошибка была в процедуре TimeOutHandler). Буду исправлять файл ответов. Спасибо, victor, успехов вам! Кстати, при выкладке кода на этом форуме используют тэг Code.

Код: Выделить всё

var F: Text;  { входной файл,
                в первой строке - период опроса входной очереди,
                в последующих - списки запросов }
    Period: integer;        { период опроса входной очереди }
    TimeOut: integer;       { таймаут чтения входной очереди }
    Track: integer;         { текущий запрос из внутренней очереди }
    Position: integer;      { текущая позиция головки }
    ProgramResult: integer; { общее время работы программы }

{----------------------------------------------------------}
{ Постановка в очередь и извлечение из нее }

var Que: string;  { очередь }

procedure PutInQue(aTrack: integer); { Постановка в очередь }
begin
  Que:= Que + Char(aTrack);   { добавляем в конец строки}
end;

function GetFromQue: integer;  { Выбор из очереди }
begin
  if Length(Que) = 0         { если очередь пуста }
    then GetFromQue:= -1
    else begin
      GetFromQue:= Ord(Que[1]); { возвращаем первый элемент }
      Delete (Que, 1, 1);         { и удаляем его из очереди }
    end
end;

{----------------------------------------------------------}
{ Проверка истечения таймаута
 и чтение очередной порции запросов из строки файла }

procedure TimeOutHandler;
var N: integer;
begin
  if TimeOut>0 then begin
     Inc(ProgramResult);    { общее время }
     Dec(TimeOut);
  end;
  if TimeOut=0 then begin
      TimeOut:= Period;
      { Если истек таймаут, читаем порцию из файла }
      if not EoF(F) then begin
        while not Eoln(F) do begin
          Read(F, N);
          PutInQue(N)
        end;
        Readln(F);
      end;
  end;
end;
{----------------------------------------------------------}
{ Обработка запроса на чтение-запись дорожки }

procedure QueryHandler(aTrack: integer);
begin
  Write(aTrack:4);
  { продвигаем головку в требуемую позицию }
  while Position<>aTrack do begin
    if Position<aTrack
      then Inc(Position)
      else Dec(Position);
    TimeOutHandler;  { таймаут чтения из файла }
  end;
  { Один квант тратим на чтение-запись }
  TimeOutHandler;    { таймаут чтения из файла }
end;

{----------------------------------------------------------}

begin   { Main }
  Writeln('a_53_4');
  ProgramResult:=0;     { Общее время }
  Position:=0;          { позиция головки }
  TimeOut:= 0;          { таймаут }
  Que:='';              { внутренняя очередь пуста }
  Assign(F, 'Disk.in'); Reset(F);
  Readln(F,Period); { в первой строке – период опроса очереди }
  repeat
    Track:= GetFromQue;   { извлекаем из внутр. очереди }
    if Track>=0
      then QueryHandler(Track)  { выполнить запрос }
      else if Eof(F)    { если входной файл пуст }
             then Break { то выход }
             else TimeOutHandler;{ а иначе отрабатываем таймаут
                                и читаем строку файла }
  until false;
  Writeln;
  Write('Result= ',ProgramResult); Readln;
end.

[viktorf9]

Спасибо, буду знать про тег.
Кстати, если позволите, еще небольшой комментарий по самому учебнику. Дошел до 56-ой главы. В ней в задачах предлагается проверить работу функции MemAvail
Но как я понял эту функцию удалили из последних версий программной среды. Вот тут нашел объяснение
http://www.freepascal.ru/forum/viewtopic.php?f=5&t=8633

[Oleg_D]

Так оно и есть, эти функции применялись во времена MS-DOS, и это задание, конечно, устарело.