Задачи к главе 54.

Книга адресована школьникам средних и старших классов, желающим испытать себя в «олимпийских схватках». Может быть полезна студентам-первокурсникам и преподавателям информатики.

Модераторы: Oleg_D, Модераторы

Задачи к главе 54.

Сообщение Paster Fob » 15.03.2013 11:58:13

Доброго времени суток.Показываю свои решения задач А,В,Г. При написании учёл ваши замечания,пытаюсь исправляться.
Задачи А и В я объединил и немного изменил условие,удалять можно любой не только первый,хотя про удаление только в следующей главе говориться.

Код: Выделить всё
type
  prec=^rec;
  rec=record
    mnum:integer;
    mfam:string;
    mnext:prec;
  end;

var
  list:prec;
  f:text;

procedure AddToList;
var
  p:prec;
begin
  list:=nil;
  while not eof(f) do begin
    new(p);
    read(f,p^.mnum);
    readln(f,p^.mfam);
    p^.mnext:=list;
    list:=p;
  end;
end;

function CountMembers:byte;
var
  p:prec;
  i:byte;
begin
  p:=list; i:=0;
  while assigned(p) do begin
    inc(i);
    p:=p^.mnext;
  end;
  CountMembers:=i;
end;

procedure PrintList;
var
  p:prec;
begin
  p:=list;
  while assigned(p) do begin
    writeln(p^.mnum,p^.mfam);
    p:=p^.mnext;
  end;
  writeln;
end;

procedure DeleteMember(an:byte);
var
  i:byte;
  p,q:prec;
begin
  i:=1; p:=list;
  while i<an-1 do begin
    p:=p^.mnext;
    inc(i);
  end;
  q:=p;
  p:=p^.mnext;
  if an=1 then begin
    list:=p;
    dispose(q);
  end
  else begin
    q^.mnext:=p^.mnext;
    dispose(p);
  end;
end;

var
  count,n:byte;

begin
  assign(f,'C:\Files for Program Pascal\Policebase2.txt');
  reset(f);
  AddToList;
  close(f);
  PrintList;
  count:=CountMembers;
  writeln('Кол-во элементов в списке : ',count);
  writeln('Какой элемент удалить?');
  repeat
    readln(n);
    if (n>0) and (n<=count) then
      break
    else
      writeln('Не корректный ввод.Попробуйте ещё раз!');
  until false;
  writeln;
  DeleteMember(n);
  PrintList;
  readln;
end.


А вот с задачей Г пришлось не много по мучиться.
Ваша подсказка мне не понравилась(создание двух списков), я решил сделать по-своему.Идея решения заключалась в следующем:
нужно найти элемент в списке с минимальным номером,если он не в голове списка,то ставим его в начало,теперь снова ищем минимальный,но поиск начинаем со второго элемента,затем вставляем его после первого,поиск продолжаем уже с третьего и вставляем найденный после второго и.т.д.
Вот что в итоге получилось:

Код: Выделить всё
type
  prec=^trec;
  trec=record
    mnum:integer;
    mfam:string;
    mnext:prec;
  end;

var
  list:prec;
  f:text;

procedure AddToList;
var
  p:prec;
begin
  while not eof(f) do begin
    new(p);
    read(f,p^.mnum);
    readln(f,p^.mfam);
    p^.mnext:=list;
    list:=p;
  end;
end;

{---поиск элемента с минимальным номером---}
procedure FindMin(var ap,aq,amn:prec);
var
  p:prec;
begin
  p:=aq;
  while assigned(p^.mnext) do begin
    if p^.mnext^.mnum<amn^.mnum then  begin
      amn:=p^.mnext; // ищем элемент с минимальным номером
      ap:=p;         // запоминаем элемент перед минимальным
    end;
    p:=p^.mnext;
  end;
end;

{---сортировка списка---}
procedure SortList;
var
  p,q,r,mn:prec;
{p-предыдущий минимального; q-начальная позиция поиска
минимального элемента; r-вставляем минимальный элемент
после него; mn:минимальный элемент}
begin
  p:=list; q:=list; r:=list;
  while assigned(q) do begin
    mn:=q;
    FindMin(p,q,mn); // ищем минимальный элемент
    if mn^.mnum<list^.mnum then begin
      {если минимальный меньше того что в голове
       списка,то ставим его в начало списка}
      p^.mnext:=mn^.mnext;
      mn^.mnext:=list;
      list:=mn;
      q:=list^.mnext;
      r:=list;
    end
    else begin
      if p^.mnext<>mn then begin
        {если предыдущий элемент не ссылается на
         найденный минимальный}
        if p=list then q:=q^.mnext
        {если первый найденный минимальный элемент
         находится в голове списка,то и указатель на
         предыдущий элемент тоже будет указывать на
         голову,следовательно двигаемся по списку дальше }
        else begin
        {ничего не переставляем,двигаемся дальше по списку}
          q:=q^.mnext;
          r:=r^.mnext;
        end;
      end
      else begin
        {иначе связываем элементы и продвигаемся
         дальше по списку}
        p^.mnext:=mn^.mnext;
        mn^.mnext:=r^.mnext;
        r^.mnext:=mn;
        r:=r^.mnext;
        q:=r^.mnext;
      end;
    end;
  end;
end;

procedure PrintList;
var
  p:prec;
begin
  p:=list;
  while assigned(p) do begin
    writeln(p^.mnum,p^.mfam);
    p:=p^.mnext;
  end;
  writeln;
end;

begin
  assign(f,'C:\Files for Program Pascal\Policebase2.txt');
  reset(f);
  list:=nil;
  AddToList;
  PrintList;
  SortList;
  PrintList;
  readln;
end.


Теперь беда с задачей Д.(умный винчестер),никак не пойму как здесь происходит чтение дорожек и движение к ним,может объясните?
Аватара пользователя
Paster Fob
постоялец
 
Сообщения: 188
Зарегистрирован: 22.02.2011 21:53:36
Откуда: Новосибирск.

Re: Задачи к главе 54.

Сообщение Oleg_D » 18.03.2013 11:22:11

В связи с поездкой задержался с ответом.

1) По первой задаче. Она работает, и это гуд. Но есть пара замечаний на будущее.
а) Для счётчика вместо Byte лучше подходит Integer, а Byte уместен для больших массивов мелких чисел.
б) Процедура удаления DeleteMember завязана с вызывающим её куском программы в том смысле, что корректность номера удаляемого элемента проверяется за пределами процедуры. Если вызвать процедуру как-то иначе, она может «рухнуть» из-за некорректного значения параметра. Таких завязок следует избегать.
Это повод, чтобы вновь обратить внимание на развязку отдельных кусков программы. Развязка -- это общеинженерный принцип. Загляните внутрь системного блока и увидите материнскую плату, винчестер, блок питания. Вы можете заменить любой из этих узлов моделью другого производителя (поставить более мощный БП, или более ёмкий винчестер), и это не скажется на других узлах. Это и есть развязка.

2) Вторая задача тоже дышит, хотя детально не проверял. Идея понятна, но сами видите (сравните свою процедуру с AddToSortList на стр. 431), что витиевато сделано, сложно. Это плюс вашим мозгам, но минус вашему опыту. :) А опытный программист пишет просто, поскольку три простые процедуры лучше одной сложной. Моя подсказка насчёт удаления первого элемента и вставки его в другой список подразумевала то, что процедуру удаления первого элемента написать легко, а вторая уже готова. А завести две головы – не проблема.
Но в целом, я вижу, со списками вы неплохо разобрались. :)

Paster Fob писал(а):Теперь беда с задачей Д.(умный винчестер),никак не пойму как здесь происходит чтение дорожек и движение к ним,может объясните?

Представьте, что дорожкам соответствуют коробочки, в которые при чтении входной очереди (файла) падают монетки – это запросы. Когда головка подходит к очередной непустой коробочке, она должна опустошить её, выполнив N-е количество запросов, и двинуться дальше в том же направлении, если там ещё есть непустые коробочки. А если дальше всё пусто, или дошли до края, то поворачиваем назад. Это и есть челночное движение головки.
Oleg_D
постоялец
 
Сообщения: 391
Зарегистрирован: 09.05.2011 11:28:36

Re: Задачи к главе 54.

Сообщение Paster Fob » 18.03.2013 11:48:13

Oleg_D писал(а):Представьте, что дорожкам соответствуют коробочки, в которые при чтении входной очереди (файла) падают монетки – это запросы. Когда головка подходит к очередной непустой коробочке, она должна опустошить её, выполнив N-е количество запросов, и двинуться дальше в том же направлении, если там ещё есть непустые коробочки. А если дальше всё пусто, или дошли до края, то поворачиваем назад. Это и есть челночное движение головки.


Ну вот например строки в файле рассмотренные ранее:
Код: Выделить всё
100
50 10 250 30 10
20 40 20 10 60
15 10 25
51 11 251 31 11
21 41 21 11 61

как должна двигаться головка?
сначала в очередь попадает 1-ая строка.Двигаемся от 0 на возрастание,а то что меньше пропускаем.
50,250,добавилось ещё 3 строки ,далее 251,добавилась последняя строка,теперь идём на убыль 61,60,51,50 и т.д. на убыль.
Если так,то нарушается вся очередь.Что-то не могу понять я смысл всего этого. :( :?:
Аватара пользователя
Paster Fob
постоялец
 
Сообщения: 188
Зарегистрирован: 22.02.2011 21:53:36
Откуда: Новосибирск.

Re: Задачи к главе 54.

Сообщение Oleg_D » 18.03.2013 12:00:19

Paster Fob писал(а):Если так,то нарушается вся очередь.

Да, очерёдность обслуживания нарушается, но так и должно быть. А смысл в том, чтобы снизить общее время обслуживания всех запросов в совокупности и тем самым общую производительность компьютера.
Oleg_D
постоялец
 
Сообщения: 391
Зарегистрирован: 09.05.2011 11:28:36

Re: Задачи к главе 54.

Сообщение Paster Fob » 25.03.2013 15:07:57

Здравствуйте,уезжал на несколько дней,задержался с решением.
Я вот никак не могу понять как должна обрабатываться очередь в этой задаче?
Как я понял:
Получаем запрос на первоначальную очередь и ставим в неё первую строку файла,теперь в очереди номера дорожек: 50 10 250 30 10.
Первоначальное положение головки равно 0.Первая дорожка в очереди равна 50,двигаемся к ней и считаем время.Далее удаляем её номер из очереди и идём к следующей дорожке которая больше предыдущей это дорожка 250 и при достижении периода в 100 единиц проверяем есть ли ещё запросы и добавляем их.Теперь в очереди следующие номера дорожек. 10 30 10 20 40 20 10 60 15 10 25 .В очереди нет больше запросов с большим значением,значит идём на убыль.Время потраченное на перемещение и чтение равно 252 кванта. Начинаем с конца,номер первой дорожки равен 25,передвигаем головку с 250-ой дорожки до 25, добавляются ещё запросы в очередь. теперь она выглядит так: 10 30 10 20 40 20 10 60 15 10 51 11 251 31 11 21 41 21 11 61
Просматриваем очередь ещё раз с конца(после добавление элементов). 25 => 11 => 11 => 11 => 10 => 10 => 10 => 10,
состояние очереди: 30 20 40 20 60 15 51 251 31 21 41 21 61 , время 500 квант.
10 => 30 => 40 => 60 => 251 ,состояние очереди: 20 20 15 51 31 21 41 21 61 ,время 745 квант.
251 => 61 => 21 => 21 => 15 ,состояние очереди: 20 20 51 31 41 ,время 985 квант.
20 => 20 => 51 ,Состояние очереди: 31 41 ,время 1024 квант.
51 = 41 = 31 ,очередь пуста ,время 1046 квант.
Вот решение задачи:

Код: Выделить всё
var
  kw:integer; { квант-время работы программы }
  pr:integer;  { период опроса очереди }
  tr:byte;       { текущая позиция головки }
  req:byte;     { запрос из очереди }
  f:text;
  que:string;

function Request:string;
var
  s:string;
  n:byte;
begin
  s:='';
  while not eoln(f) do begin
    read(f,n);
    s:=s+chr(n);
  end;
  readln(f);
  Request:=s;
end;

procedure PutInQue;
begin
  que:=que+Request
end;

procedure GetFromQue(ind:byte);
begin
  delete(que,ind,1);
end;

procedure CountTime(afl:boolean);
var
  i:integer;
begin
  if afl=true then begin
    if tr<>req then
      for i:=tr+1 to req do begin
        inc(kw);
        if (kw mod pr=0) and (not eof(f)) then
          PutInQue;
      end
  end
  else begin
    if tr<>req then
      for i:=tr-1 downto req do begin
        inc(kw);
        if (kw mod pr=0) and (not eof(f)) then
          PutInQue;
      end;
  end;
  if tr<>req then
    tr:=req;
  if tr=req then begin
    inc(kw);
    if (kw mod pr=0) and not (eof(f)) then
      PutInQue;
  end;
end;

procedure MoveRight;
var
  fl:boolean;
  i:integer;
begin
  fl:=true;
  i:=1;
  while i<=length(que) do begin
    req:=ord(que[i]);
    if tr=req then begin
      CountTime(fl);
      GetfromQue(i);
    end
    else
    if req<tr then
      inc(i)
    else begin
      CountTime(fl);
      GetFromQue(i);
    end;
  end;
end;

procedure MoveLeft;
var
  fl:boolean;
  i,j:integer;
begin
  fl:=false;
  i:=length(que);
  j:=i;
  while i>0 do begin
    req:=ord(que[i]);
    if tr=req then begin
      CountTime(fl);
      GetfromQue(i);
      dec(i);
    end
    else
    if req>tr then
      dec(i)
    else begin
      CountTime(fl);
      GetFromQue(i);
      dec(i);
    end;
    if Length(que)>j then begin
      i:=length(que);
      j:=i;
    end;
  end;
end;

procedure ProcessRequests;
var
  i:byte;
begin
  while length(que)>0 do begin
    MoveRight;
    MoveLeft;
  end;
end;

begin
  assign(f,'C:\Files for Program Pascal\Disk.in');
  reset(f);
  readln(f,pr);
  que:=''; tr:=0; kw:=0;
  PutInQue;
  ProcessRequests;
  close(f);
  writeln('Time = ',kw);
  readln;
end.
Аватара пользователя
Paster Fob
постоялец
 
Сообщения: 188
Зарегистрирован: 22.02.2011 21:53:36
Откуда: Новосибирск.

Re: Задачи к главе 54.

Сообщение Oleg_D » 25.03.2013 16:08:46

Paster Fob писал(а):Получаем запрос на первоначальную очередь и ставим в неё первую строку файла,теперь в очереди номера дорожек: 50 10 250 30 10.

Вот с первого момента уже не так понимаете, поэтому дальше решение не стал проверять.
Да, после чтения первой строки в очереди 5 запросов: 50 10 250 30 10. Но контроллер выстраивает их в свою внутреннюю очередь так:
10(2) 30 50 250
Поэтому он сначала двигается от 0-й к 10-й дорожке, выполняет там два запроса, потом к 30, 50 и к 250.
Через 100 квантов (когда 250-я ещё не обработана) считываем следующую строку: 20 40 20 10 60, которую контроллер выстроит себе так:
10 20(2) 40 60 250
Здесь контроллер продолжает двигаться к 250. Затем считывается 3-я строка: 15 10 25 и внутренняя очередь становится такой:
10(2) 15 20(2) 25 40 60 250
Но головка по прежнему двигается к 250-й, пока не обработает её. Затем разворачивается и обрабатывает оставшиеся запросы в обратном порядке:
60 40 25 20(2) 15 10(2)
Рассматривайте дорожки как массив чисел N[0..255], хранящий количество запросов к контроллеру в текущий момент времени.
Oleg_D
постоялец
 
Сообщения: 391
Зарегистрирован: 09.05.2011 11:28:36

Re: Задачи к главе 54.

Сообщение Paster Fob » 25.03.2013 16:57:48

Теперь понятно зачем массив применять :idea: .А то я понять не мог зачем он нужен :( :?: .Приступаю к решению :) .
Аватара пользователя
Paster Fob
постоялец
 
Сообщения: 188
Зарегистрирован: 22.02.2011 21:53:36
Откуда: Новосибирск.

Re: Задачи к главе 54.

Сообщение Paster Fob » 02.04.2013 22:24:55

Немного задержался с ответом.
Вот что у меня получилось.

Код: Выделить всё
const
  tracks=255;

type
  tdisk=array [0..tracks] of byte;

var
  tr,min,max:byte; { текущая дорожка,минимальный и максимальный запрос }
  pr,kw:integer;   { период опроса очереди,квант }
  count:integer;   { количество не обработанных запросов }
  disk:tdisk;      { внутренняя очередь }
  f:text;

procedure PutInQue;
var
  n:byte;
begin
  while not eoln(f) do begin
    read(f,n);
    inc(disk[n]);
    inc(count);
    if n>max then max:=n;
    if n<min then min:=n;
  end;
  readln(f);
end;

Procedure CountTime;
begin
  inc(kw);
  if (kw mod pr=0) and not (eof(f))then
    PutInQue;
end;

procedure GetFromQue;
var
  i:byte;
begin
  while disk[tr]>0 do begin
    dec(disk[tr]);
    CountTime;
    dec(count);
  end;
end;

procedure MoveRight;
begin
  while tr<max do begin
    inc(tr);
    CountTime;
    if disk[tr]>0 then GetFromQue;
  end;
end;

procedure MoveLeft;
begin
  while tr>min do begin
    dec(tr);
    CountTime;
    if disk[tr]>0 then GetFromQue;
  end;
end;

Procedure ProcessQue;
begin
  while count>0 do begin
    MoveRight;
    if count>0 then MoveLeft;
  end;
end;

begin
  assign(f,'C:\Files for Program Pascal\Disk.in');
  reset(f);
  readln(f,pr);
  max:=0; min:=tracks;
  tr:=0; kw:=0; count:=0;
  fillchar(disk,sizeof(disk),0);
  PutInQue;
  ProcessQue;
  close(f);
  write('Time = ',kw);
  readln;
end.

и ещё один вариант,правда не намного отличаются они:

Код: Выделить всё
const
  tracks=255;

type
  tdisk=array [0..tracks] of byte;

var
  disk:tdisk;
  que:string;
  tr,min,max:byte;
  pr,kw:integer;
  f:text;

procedure PutInQue;
var
  n:byte;
begin
  while not eoln(f) do begin
    read(f,n);
    que:=que+char(n);
    inc(disk[n]);
    if n>max then max:=n;
    if n<min then min:=n;
  end;
  readln(f);
end;

Procedure CountTime;
begin
  inc(kw);
  if (kw mod pr=0) and not (eof(f))then
    PutInQue;
end;

procedure GetFromQue;
var
  i:byte;
begin
  while disk[tr]>0 do begin
    dec(disk[tr]);
    CountTime;
    for i:=1 to length(que) do
      if ord(que[i])=tr then begin
        delete(que,i,1);
        break;
      end;
  end;
end;

procedure MoveRight;
begin
  while tr<max do begin
    inc(tr);
    CountTime;
    if disk[tr]>0 then GetFromQue;
  end;
end;

procedure MoveLeft;
begin
  while tr>min do begin
    dec(tr);
    CountTime;
    if disk[tr]>0 then GetFromQue;
  end;
end;

Procedure ProcessQue;
begin
  while length(que)>0 do begin
    MoveRight;
    if length(que)>0 then
      MoveLeft;
  end;
end;

begin
  assign(f,'C:\Files for Program Pascal\Disk.in');
  reset(f);
  readln(f,pr);
  max:=0; min:=tracks;
  tr:=0; kw:=0;
  que:='';
  fillchar(disk,sizeof(disk),0);
  PutInQue;
  ProcessQue;
  close(f);
  writeln('Time = ',kw);
  readln;
end.


В итоге результат подсчёта выше указанного файла равен 754 кванта против 1424 (глупый винчестер).
Аватара пользователя
Paster Fob
постоялец
 
Сообщения: 188
Зарегистрирован: 22.02.2011 21:53:36
Откуда: Новосибирск.

Re: Задачи к главе 54.

Сообщение Oleg_D » 03.04.2013 09:44:28

В моём варианте получается 508 квантов.
В вашем решении мне не понятна роль переменных MAX и MIN.
По идее, пока двигаетесь вправо, вы должны отслеживать MAX, а достигнув этой крайней дорожки, MAX сбросить и повернуть влево.
Точно также, двигаясь влево, надо отслеживать MIN, а достигнув этой крайней дорожки, MIN сбросить и повернуть вправо.
И так повторять до обработки всех запросов. А у вас MIN и MAX нигде не сбрасываются.
Или я что-то не так понял?
Oleg_D
постоялец
 
Сообщения: 391
Зарегистрирован: 09.05.2011 11:28:36

Re: Задачи к главе 54.

Сообщение Paster Fob » 03.04.2013 22:16:06

Да,накосячил немного :) Вот исправленный вариант.
Код: Выделить всё
const
  tracks=255;

type
  tdisk=array [0..tracks] of byte;

var
  disk:tdisk;
  que:string;
  tr,req:byte;
  dir:boolean;
  pr,kw:integer;
  f:text;

procedure PutInQue;
var
  n:byte;
begin
  while not eoln(f) do begin
    read(f,n);
    que:=que+char(n);
    inc(disk[n]);
  end;
  readln(f);
end;

procedure FinalTrack;
var
  i:byte;
begin
  for i:=1 to length(que) do begin
    if dir then begin
      if ord(que[i])>req then req:=ord(que[i]);
    end
    else
      if ord(que[i])<req then req:=ord(que[i]);
  end;
end;

Procedure CountTime;
begin
  inc(kw);
  if (kw mod pr=0) and not (eof(f))then begin
    PutInQue;
    FinalTrack;
  end;
end;

procedure GetFromQue;
var
  i:byte;
begin
  while disk[tr]>0 do begin
    dec(disk[tr]);
    CountTime;
    for i:=1 to length(que) do
      if ord(que[i])=tr then begin
        delete(que,i,1);
        break;
      end;
  end;
end;

procedure MoveRight;
begin
  while tr<req do begin
    inc(tr);
    CountTime;
    if disk[tr]>0 then GetFromQue;
  end;
end;

procedure MoveLeft;
begin
  while tr>req do begin
    dec(tr);
    CountTime;
    if disk[tr]>0 then GetFromQue;
  end;
end;

Procedure ProcessQue;
begin
  while length(que)>0 do begin
    dir:=true;
    FinalTrack;
    MoveRight;
    if length(que)>0 then begin
      dir:=false;
      FinalTrack;
      MoveLeft;
    end;
  end;
end;

begin
  assign(f,'C:Files for Program PascalDisk.in');
  reset(f);
  readln(f,pr);
  req:=0; tr:=0; kw:=0;
  que:='';
  fillchar(disk,sizeof(disk),0);
  PutInQue;
  ProcessQue;
  close(f);
  writeln('Time = ',kw);
  readln;
end.


Описание работы программы:
Читаем строку из файла,записываем дорожки в очередь и в массиве увеличиваем счётчики соответствующих дорожек.
Направление движения изначально на увеличение (dir:=true;) далее определяем максимальную дорожку (процедура FinalTrack) и двигаемся к ней считаем время,попутно выполняя запросы во внутренней очереди(в массиве) и удаляя их из обоих очередей,при достижении времени опроса внешней очереди добавляем во внутреннюю и внешнюю очередь ещё запросы(если они есть) и проверяем не изменилась ли максимальная дорожка,обработав её меняем направление (dir:=false) и теперь уже процедура FinalTrack определяет минимальную дорожку,теперь всё то же самое только движемся к минимальной дорожке.Повторяем пока очереди не опустеют.

Я постарался разъединить кофеварку,кресло и телевизор :D Получилось? :?:

Теперь давайте посчитаем результат сами,без программы.
Первый запрос 50 10 250 30 10 , внутренняя очередь 10(2) 30 50 250 .
Достигнув 100 и 200 кв. в очередь добавяться ещё запросы,но они будут обрабатываться когда головка пойдёт в обратном направлении.когда головка дойдёт до 250 дорожки и обработает её,время будет равно 255 кв. (движение головки от 0 до 250 + чтения-записи 5 запросов).
На этот момент очереди выглядят так:
внешняя 20 40 20 10 60 15 10 25 , внутренняя 10(2) 15 20(2) 25 40 60 .
Меняем направление.На 205 дорожке время равно 300 кв.,добавляем ещё запросы и при достижении 105 дорожки,время равно 400 кв.Добавляем последние запросы в очереди,теперь очереди выглядят так:
внешняя 20 40 20 10 60 15 10 25 51 11 251 31 11 21 41 21 11 61 , внутренняя 10(2) 11(3) 15 20(2) 21(2) 25 31 40 41 51 60 61 251 .
Двигаемся до минимальной дорожки 10,попутно выполняя все встречающиеся запросы.Время обработки равно 512 кв. (движение головки от 250 до 10 ; 255+(250-10)=495 + 17 запросов чтения-записи) В очереди осталась одна не обработанная дорожка 251.Двигаемся к ней и выполняем чтение-запись дорожки,результат 754 кв. (движение головки от 10 до 251 ; 512+(251-10)+1 запрос чтения или записи).

Я посмотрел вашу программу в ней ошибка.Я изменил чуть-чуть главную программу.Теперь кроме подсчёта времени программа показывает не обработанные дорожки.

Код: Выделить всё
var F: Text;  { входной файл,
                в первой строке - период опроса входной очереди,
                в последующих - списки запросов }
    Period: integer;        { период опроса входной очереди }
    TimeOut: integer;       { таймаут чтения входной очереди }
    Track: integer;         { текущий запрос из внутренней очереди }
    Position: integer;      { текущая позиция головки }
    Direction: integer;     { направление движения = +1 / -1 }
    ProgramResult: integer; { общее время работы программы }
{----------------------------------------------------------}
{ Постановка в очередь и извлечение из нее }

const CTracks = 256;  { количество дорожек }
type  TTracks = array[0..CTracks-1] of integer;
var   Tracks: TTracks; { массив счетчиков для дорожек }

procedure PutInQue(aItem: integer);
begin
  { наращиваем счетчик дорожки }
  Inc(Tracks[aItem]);
end;

{ Выбор из очереди }

function GetFromQue(aPos, aDirection: integer): integer;
var i: integer;
begin
  i:= aPos;
  while (i in [0..CTracks-1]) and (Tracks[i]=0)
    do i:=i+aDirection;  { +1/-1 }
  if i in [0..CTracks-1]
    then begin
           GetFromQue:= i;
           Dec(Tracks[i])
         end
    else GetFromQue:=-1;
end;

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

procedure TimeOutHandler;
var N: integer;
begin
if TimeOut>0 then begin
     Dec(TimeOut);
     Inc(ProgramResult);
   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:5); }
  { Продвижение к дорожке }
  while Position<>aTrack do begin
    if Position<aTrack
      then Inc(Position)
      else Dec(Position);
    TimeOutHandler;
  end;
  { Чтение-запись дорожки + 1 квант }
  TimeOutHandler;
end;
{----------------------------------------------------------}
var
  i:byte;

begin   { Main }
  ProgramResult:=0;     { Общее время }
  Position:=0;          { позиция головки }
  TimeOut:= 0;          { таймаут }
  Direction:=+1;        { начальное направление движения головки }
  FillChar(Tracks, SizeOf(Tracks), 0);
  Assign(F, 'C:\Files for Program Pascal\Disk.in'); Reset(F);
  Readln(F, Period);    { в первой строке – период опроса очереди }
  repeat
    Track:= GetFromQue(Position, Direction);   { извлекаем запрос }
    if Track>=0
      then QueryHandler(Track) { обрабатываем }
      else if Eof(F)           { если входной файл прочитан }
             then Break        { то выход }
             else begin
               TimeOutHandler;{ а иначе таймаут и читаем строку файла }
               Direction:= -Direction; { меняем направление движения }
             end;
  until false;
  Writeln('Result= ',ProgramResult);
  for i:=0 to ctracks-1 do
    if tracks[i]>0 then writeln(i,'  ',tracks[i]);
  Readln;
end.
Аватара пользователя
Paster Fob
постоялец
 
Сообщения: 188
Зарегистрирован: 22.02.2011 21:53:36
Откуда: Новосибирск.

Re: Задачи к главе 54.

Сообщение Oleg_D » 04.04.2013 12:00:12

Paster Fob писал(а):Я постарался разъединить кофеварку,кресло и телевизор Получилось?

Да, двигаетесь в верном направлении. :D
Но в последней версии нехорошо то, что очередь запросов зачем-то дублируете, это всё усложняет и запутывает. Ваша первая идея с max и min мне гораздо больше нравится, я подправил её и вот что получилось (добавил ещё и процедуру отладочной печати).
Код: Выделить всё
const
  tracks=255;

type
  tdisk=array [0..tracks] of byte;

var
  tr,min,max : integer; { текущая дорожка,минимальный и максимальный запрос }
  pr,kw      : integer; { период опроса очереди, квант }
  count      : integer; { количество не обработанных запросов }
  disk : tdisk;  { внутренняя очередь }
  f:text;

{-------------------------------------------------------------------}
{ Отладочная распечатка очереди }

var Log: Text;  { файл отладочной распечатки }

procedure Dump(direct : integer);
var i: integer;
begin
  Write(Log, direct:2,'(', tr:3, ') = ');
  for i:=0 to tracks-1 do
    if disk[i]>0 then Write(Log, i:4,':',disk[i]);
  Writeln(Log);
end;

{-------------------------------------------------------------------}
{ Загрузка порции из файла }

procedure PutInQue;
var
  n:byte;
begin
  while not eoln(f) do begin
    read(f,n);
    inc(disk[n]);
    inc(count);
    if n>max then max:=n;
    if n<min then min:=n;
  end;
  readln(f);
end;

{-------------------------------------------------------------------}
{ Подсчёт времени и загрузка порции }

Procedure CountTime;
begin
  inc(kw);
  if (kw mod pr=0) and not (eof(f))then
    PutInQue;
end;

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

procedure MoveRight;
begin
  while tr<=max do begin
    if disk[tr]>0
      then begin
            Dump(+1);       { для отладки }
            Dec(disk[tr]);  { обработка запроса на текущей дорожке }
            Dec(Count);
           end
      else Inc(tr);         { переход на следующую дорожку }
    CountTime;
  end;
  max:=-1    { сброс правой границы }
end;

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

procedure MoveLeft;
begin
  while tr>=min do begin
    if disk[tr]>0
      then begin
            Dump(-1);       { для отладки }
            Dec(disk[tr]);  { обработка запроса на текущей дорожке }
            Dec(Count);
           end
      else Dec(tr);         { переход на следующую дорожку }
    CountTime;
  end;
  min:= tracks+1     { сброс левой границы }
end;

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

Procedure ProcessQue;
begin
  while count>0 do begin
    MoveRight;
    if count>0 then MoveLeft;
  end;
end;

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

begin

  Assign(Log, 'Log.txt'); Rewrite(Log);

  assign(f,'Disk.in');
  reset(f);
  readln(f,pr);
  max:=0; min:=tracks;
  tr:=0; kw:=0; count:=0;
  fillchar(disk,sizeof(disk),0);
  PutInQue;
  ProcessQue;
  close(f);
  write('Time = ',kw);
  Close(Log);
  readln;
end.

А в моей программе действительно ошибка была (поленился проверить как следует!).
Вот исправленный вариант (изменение в Main).
Код: Выделить всё
var F: Text;  { входной файл,
                в первой строке - период опроса входной очереди,
                в последующих - списки запросов }
    Period: integer;        { период опроса входной очереди }
    TimeOut: integer;       { таймаут чтения входной очереди }
    Track: integer;         { текущий запрос из внутренней очереди }
    Position: integer;      { текущая позиция головки }
    Direction: integer;     { направление движения = +1 / -1 }
    ProgramResult: integer; { общее время работы программы }
{----------------------------------------------------------}
{ Постановка в очередь и извлечение из нее }

const CTracks = 256;  { количество дорожек }
type  TTracks = array[0..CTracks-1] of integer;
var   Tracks: TTracks; { массив счетчиков для дорожек }

procedure PutInQue(aItem: integer);
begin
  { наращиваем счетчик дорожки }
  Inc(Tracks[aItem]);
end;

{ Выбор из очереди }

function GetFromQue(aPos, aDirection: integer): integer;
var i: integer;
begin
  i:= aPos;
  while (i in [0..CTracks-1]) and (Tracks[i]=0)
    do i:=i+aDirection;  { +1/-1 }
  if i in [0..CTracks-1]
    then begin
           GetFromQue:= i;
           Dec(Tracks[i])
         end
    else GetFromQue:=-1;
end;

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

procedure TimeOutHandler;
var N: integer;
begin
if TimeOut>0 then begin
     Dec(TimeOut);
     Inc(ProgramResult);
   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:5); }
  { Продвижение к дорожке }
  while Position<>aTrack do begin
    if Position<aTrack
      then Inc(Position)
      else Dec(Position);
    TimeOutHandler;
  end;
  { Чтение-запись дорожки + 1 квант }
  TimeOutHandler;
end;

{----------------------------------------------------------}
{ Отладочная распечатка очереди }

var Log: Text;

procedure Dump;
var i: integer;
begin
  Write(Log, Direction:2,'(', Position:3, ') = ');
  for i:=0 to ctracks-1 do
    if tracks[i]>0 then Write(Log, i:4,':',tracks[i]);
  Writeln(Log);
end;

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

begin   { Main }

  Assign(Log, 'Log.txt'); Rewrite(Log);

  ProgramResult:=0;     { Общее время }
  Position:=0;          { позиция головки }
  TimeOut:= 0;          { таймаут }
  Direction:=+1;        { начальное направление движения головки }
  FillChar(Tracks, SizeOf(Tracks), 0);
  Assign(F, 'Disk.in'); Reset(F);
  Readln(F, Period);    { в первой строке – период опроса очереди }
  repeat
    Dump;
    Track:= GetFromQue(Position, Direction);   { извлекаем запрос }
    if Track>=0
      then QueryHandler(Track) { обрабатываем }
      else begin
        Direction:= -Direction; { меняем направление движения }
        Track:= GetFromQue(Position, Direction);   { извлекаем запрос }
        if Track>=0
           then QueryHandler(Track) { обрабатываем }
           else TimeOutHandler;{ а иначе таймаут и читаем строку файла }
      end;
  until Eof(F) and (Track<0);
  Writeln('Result= ',ProgramResult);
  Dump;
  Readln;
  Close(Log)
end.


Сейчас первая из этих программ выдаёт 759, а вторая 748 квантов.
В общем, сходство приемлемо, а при желании можете покопаться и выяснить причину расхождения.

Добавлено спустя 21 час 47 минут 22 секунды:
Вот уточнённый вариант с MAX/MIN, он выдаёт 754 кванта.
Код: Выделить всё
const
  tracks=255;

type
  tdisk=array [0..tracks] of byte;

var
  tr,min,max : integer; { текущая дорожка,минимальный и максимальный запрос }
  pr,kw      : integer; { период опроса очереди, квант }
  count      : integer; { количество не обработанных запросов }
  disk : tdisk;  { внутренняя очередь }
  f:text;

{-------------------------------------------------------------------}
{ Отладочная распечатка очереди }

var Log: Text;  { файл отладочной распечатки }

procedure Dump(direct : integer);
var i: integer;
begin
  Write(Log, direct:2,'(', tr:3, ') = ');
  for i:=0 to tracks-1 do
    if disk[i]>0 then Write(Log, i:4,':',disk[i]);
  Writeln(Log);
end;

{-------------------------------------------------------------------}
{ Загрузка порции из файла }

procedure PutInQue;
var
  n:byte;
begin
  while not eoln(f) do begin
    read(f,n);
    inc(disk[n]);
    inc(count);
    if n>max then max:=n;
    if n<min then min:=n;
  end;
  readln(f);
end;

{-------------------------------------------------------------------}
{ Подсчёт времени и загрузка порции }

Procedure CountTime;
begin
  inc(kw);
  if (kw mod pr=0) and not (eof(f))then
    PutInQue;
end;

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

procedure MoveRight;
begin
  while tr<=max do begin
    if disk[tr]>0
      then begin
            Dump(+1);       { для отладки }
            Dec(disk[tr]);  { обработка запроса на текущей дорожке }
            Dec(Count);
            CountTime;
           end
      else if tr<max
             then begin
               Inc(tr);     { переход на следующую дорожку }
               CountTime;
             end else Break;
  end;
  max:=-1    { сброс правой границы }
end;

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

procedure MoveLeft;
begin
  while tr>=min do begin
    if disk[tr]>0
      then begin
            Dump(-1);       { для отладки }
            Dec(disk[tr]);  { обработка запроса на текущей дорожке }
            Dec(Count);
            CountTime;
           end
      else if tr>min
             then begin
               Dec(tr);     { переход на следующую дорожку }
               CountTime;
             end else Break;
  end;
  min:= tracks+1     { сброс левой границы }
end;

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

Procedure ProcessQue;
begin
  while count>0 do begin
    MoveRight;
    if count>0 then MoveLeft;
  end;
end;

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

begin

  Assign(Log, 'Log.txt'); Rewrite(Log);

  assign(f,'Disk.in');
  reset(f);
  readln(f,pr);
  max:=0; min:=tracks;
  tr:=0; kw:=0; count:=0;
  fillchar(disk,sizeof(disk),0);
  PutInQue;
  ProcessQue;
  close(f);
  write('Time = ',kw);
  Close(Log);
  readln;
end.
Oleg_D
постоялец
 
Сообщения: 391
Зарегистрирован: 09.05.2011 11:28:36

Re: Задачи к главе 54.

Сообщение Paster Fob » 06.04.2013 22:40:22

Я переправил таким образом:

Код: Выделить всё
const
  tracks=255;

type
  tdisk=array [0..tracks] of byte;

var
  tr,min,max : integer; { текущая дорожка,минимальный и максимальный запрос }
  pr,kw      : integer; { период опроса очереди, квант }
  count      : integer; { количество не обработанных запросов }
  disk : tdisk;  { внутренняя очередь }
  f:text;

{-------------------------------------------------------------------}
{ Отладочная распечатка очереди }

var Log: Text;  { файл отладочной распечатки }

procedure Dump(direct : integer);
var i: integer;
begin
  Write(Log, direct:2,'(', tr:3, ') = ');
  for i:=0 to tracks-1 do
    if disk[i]>0 then Write(Log, i:4,':',disk[i]);
  Writeln(Log);
end;

{-------------------------------------------------------------------}
{ Загрузка порции из файла }

procedure PutInQue;
var
  n:byte;
begin
  while not eoln(f) do begin
    read(f,n);
    inc(disk[n]);
    inc(count);
    if n>max then max:=n;
    if n<min then min:=n;
  end;
  readln(f);
end;

{-------------------------------------------------------------------}
{ Подсчёт времени и загрузка порции }

Procedure CountTime;
begin
  inc(kw);
  if (kw mod pr=0) and not (eof(f))then
    PutInQue;
end;

{-------------------------------------------------------------------}
{ удаление запросов из очереди }

procedure GetFromQue(dr:shortint);
begin
  while disk[tr]>0 do begin
    dump(dr);     { для отладки }
    dec(disk[tr]); { обработка запроса на текущей дорожке }
    dec(count);
    CountTime;
  end;
end;

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

procedure MoveRight;
begin
  while tr<max do begin
    inc(tr);      { переход на следующую дорожку }
    CountTime;
    if disk[tr]>0 then GetFromQue(1);
  end;
  max:=-1    { сброс правой границы }
end;

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

procedure MoveLeft;
begin
  while tr>min do begin
    dec(tr);     { переход на следующую дорожку }
    CountTime;
    if disk[tr]>0 then GetFromQue(-1);
  end;
  min:=tracks;  { сброс левой границы }
end;

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

Procedure ProcessQue;
begin
  while count>0 do begin
    MoveRight;
    if count>0 then MoveLeft;
  end;
end;

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

begin
  Assign(Log, 'C:\Files for Program Pascal\Log.txt');
  Rewrite(Log);
  assign(f,'C:\Files for Program Pascal\Disk.in');
  reset(f);
  readln(f,pr);
  max:=0; min:=tracks;
  tr:=0; kw:=0; count:=0;
  fillchar(disk,sizeof(disk),0);
  PutInQue;
  ProcessQue;
  close(f);
  write('Time = ',kw);
  Close(Log);
  readln;
end.


и ещё один вариант,с одним запросом выполняющего роль максимального или минимального запроса в зависимости от направления движения головки.

Код: Выделить всё
const
  tracks=255;

type
  tdisk=array [0..tracks] of byte;

var
  tr,req : integer; { текущая дорожка,минимальный и максимальный запрос }
  pr,kw  : integer; { период опроса очереди, квант }
  count  : integer; { количество не обработанных запросов }
  dir : boolean;    { направление движения головки }
  disk : tdisk;     { внутренняя очередь }
  f:text;

{-------------------------------------------------------------------}
{ Отладочная распечатка очереди }

var Log: Text;  { файл отладочной распечатки }

procedure Dump(direct : integer);
var i: integer;
begin
  Write(Log, direct:2,'(', tr:3, ') = ');
  for i:=0 to tracks-1 do
    if disk[i]>0 then Write(Log, i:4,':',disk[i]);
  Writeln(Log);
end;

{-------------------------------------------------------------------}
{ Загрузка порции из файла }

procedure PutInQue;
var
  n:byte;
begin
  while not eoln(f) do begin
    read(f,n);
    inc(disk[n]);
    inc(count);
  end;
  readln(f);
end;

{-------------------------------------------------------------------}
{ Подсчёт времени и загрузка порции }

Procedure CountTime;
begin
  inc(kw);
  if (kw mod pr=0) and not (eof(f))then
    PutInQue;
end;

{-------------------------------------------------------------------}
{ удаление из очереди }

procedure GetFromQue(dr:shortint);
begin
  while disk[tr]>0 do begin
    dump(dr);
    dec(disk[tr]);
    dec(count);
    CountTime;
  end;
end;

{-------------------------------------------------------------------}
{ нахождение минимальной или максимальной дорожки }

procedure FinalTrack;
var
  i:byte;
begin
  for i:=0 to tracks do begin
    if dir then begin
      if (disk[i]>0) and (i>req) then req:=i;
    end
    else
      if (disk[i]>0) and (i<req) then req:=i;
  end;
end;

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

procedure MoveRight;
begin
  while tr<req do begin
    inc(tr);
    CountTime;
    if disk[tr]>0 then GetFromQue(1);
  end;
end;

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

procedure MoveLeft;
begin
  while tr>req do begin
    dec(tr);
    CountTime;
    if disk[tr]>0 then GetFromQue(-1);
  end;
end;

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

Procedure ProcessQue;
begin
  while count>0 do begin
    dir:=true;
    FinalTrack;
    MoveRight;
    if count>0 then begin
      dir:=false;
      FinalTrack;
      MoveLeft;
    end;
  end;
end;

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

begin
  assign(Log, 'C:\Files for Program Pascal\Log.txt');
  Rewrite(Log);
  assign(f,'C:\Files for Program Pascal\Disk.in');
  reset(f);
  readln(f,pr);
  req:=0; tr:=0; kw:=0; count:=0;
  fillchar(disk,sizeof(disk),0);
  PutInQue;
  ProcessQue;
  close(f);
  write('Time = ',kw);
  Close(Log);
  readln;
end.


Но вариант с min и max по идее должен работать быстрее,т.к. они находятся сразу при чтении запросов из файла.
Аватара пользователя
Paster Fob
постоялец
 
Сообщения: 188
Зарегистрирован: 22.02.2011 21:53:36
Откуда: Новосибирск.

Re: Задачи к главе 54.

Сообщение Oleg_D » 07.04.2013 11:25:04

Paster Fob писал(а):Я переправил таким образом

Теперь всё выглядит просто и понятно, океюшки :D
Oleg_D
постоялец
 
Сообщения: 391
Зарегистрирован: 09.05.2011 11:28:36


Вернуться в Книга "Песни о Паскале"

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 2

Рейтинг@Mail.ru