Отправляет email-рассылки с помощью сервиса Sendsay

RFpro.ru: Программирование на языке Pascal

Подписаться Бесплатная «Золотая» новостная рассылка . Подписчиков 2.944 RSS
←   Декабрь 2010   →
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31


За последние 60 дней ни разу не выходила


Сайт рассылки: http://prog.rusfaq.ru/pascal
Открыта: 14-03-2002

Автор
Калашников О.А.

Статистика

2.944 подписчиков
0 за неделю
←   Все выпуски   →

RFpro.ru: Программирование на языке Pascal


Хостинг портала RFpro.ru:
Московский хостер
Профессиональный ХОСТИНГ на базе Linux x64 и Windows x64

РАССЫЛКИ ПОРТАЛА RFPRO.RU

Лучшие эксперты данной рассылки

Орловский Дмитрий
Статус: Профессор
Рейтинг: 2942
∙ повысить рейтинг » 		Boriss
Статус: Академик
Рейтинг: 2573
∙ повысить рейтинг » 		Абаянцев Юрий Леонидович aka Ayl
Статус: Профессионал
Рейтинг: 2101
∙ повысить рейтинг »

/ КОМПЬЮТЕРЫ И СОФТ / Программирование / Pascal (Паскаль)

Номер выпуска:1143
Дата выхода:07.12.2010, 14:00
Администратор рассылки:Boriss (Академик)
Подписчиков / экспертов:190 / 181
Вопросов / ответов:1 / 1

Вопрос № 180873: Здравствуйте, уважаемые эксперты! Прошу Вас ответить на следующий вопрос: Помогите с решением этой лабораторной на тему "Стек и Очередь" 19 вариант вот тег фаила: ЛР6http://rfpr...

Вопрос № 180873:

Здравствуйте, уважаемые эксперты! Прошу Вас ответить на следующий вопрос:
Помогите с решением этой лабораторной на тему "Стек и Очередь" 19 вариант
вот тег фаила:
ЛР6http://rfpro.ru/upload/3384
Отчет оформлять ненадо, просто требуется выполнить реализацию стека и очереди для 19 варианта на FPC и решение задачи с ипользованием данной реализации стека и очереди.
Оформить ответ как единая программа. Можно модуль, но с ними всегда проблемы - чтото со средой не то.

Спасибо за внимание.

Отправлен: 21.11.2010, 13:33
Вопрос задал: Юдин Евгений Сергеевич (3-й класс)
Всего ответов: 1
Страница вопроса »

Отвечает Сергей Бендер (6-й класс) :
Здравствуйте, Юдин Евгений Сергеевич!

Итак, готово.

1) Работает вроде правильно. Я проиграл параметрами -- результы соответствующие.
2) Из заготовок повыкидывал лишнее: что-то стёр, что-то закомментарил. Сначала пытался реализовывать всё строго по прописанному -- сильно усложняется всё без всякой пользы. (Например, удаление списка с нетипизированным указателем на Data реализуется в модлую двольно путанно. При том, что оно в программе не нужно.)
3) В задании не сказано как генерируются задачи. Сделал по собственному пониманию. dTg -- среднее время между событиями. Это величина обратная к средней частоте события в смысле показательного вероятностного распределния. Отсюда вытекает условие "if r<1/dTg".
4) Хотя в задании сказано все задачи выводить в виде (имя,время), я не понял зачем это выводить для очередей и стеков. Тем более что для одних очередей сответствует Time1, другим -- Time2. Значит надо будет писать разные процедуры вывода. Я вывел только в процессоре оставшееся вермя. Если время обязательно должно быть и в очередях со стеками, добавь или напиши мне.

В общем, вот:

List4.pas
Код:

Unit List4;
   Interface
Const   ListOk 
        = 0;
        ListNotMem      = 1;
        ListUnder       = 2;
        ListEnd         = 3;
        SizeList        = 100;
Type    BaseType        = Pointer;
        Index     = 0..SizeList;
        PtrEl   = Index;
        Element = Record
                        Data : BaseType;
                        Next : PtrEl;
                        Flag : Boolean {TRUE, если элемент    }
                                        {принадле
 жит ОЛС       }
                  End;              {FALSE, если "свободен"}
        List     = Record
                        Start,Ptr : PtrEl;
                        N : Word
                   End;
Var     MemList: array[Index] of Element;
        ListError : 0..3;
Procedure InitList(var L:List);
{Procedure PutList(var L:List; E:BaseType);
Procedure GetList(var L:List; var E:BaseType);
Function  ReadList(var L:List):Pointer;}
Function  EmptyList(var L:List):boolean;
Function
 EndList(var L:List):boolean;
Function  Count(var L:List):Word;
Procedure BeginPtr(var L:List);
Procedure MovePtr(var L:List);
{Procedure EndPtr(var L:List);
Procedure MoveTo(var L:List; N:word);
Procedure DoneList(var L:List);
Procedure CopyList(var L1,L2:List);}

Implementation

Procedure InitList(var L:List);
begin
     L.Start:=0;
     L.Ptr:=0;
     L.N:=0;
end;

{Procedure PutList(var L:List;
  E:BaseType);
Procedure GetList(var L:List; var E:BaseType);
Function  ReadList(var L:List):Pointer;}

Function  EmptyList(var L:List):boolean;
begin
  EmptyList:=L.start=0;
end;

Function  EndList(var L:List):boolean;
begin
  EndList:=MemList[L.ptr].next=0;
end; { EndList }

Function  Count(var L:List):Word;
begin
  Count:=L.N-1
end; { Count }

Procedure BeginPtr(var L:List);
begin
     if L.start=0
     then ListError:=ListNotMem
     else
begin
          ListError:=ListOk;
          L.ptr:=L.start;
     end;
end; { BeginPtr }

Procedure MovePtr(var L:List);
begin
 if L.ptr=0
 then ListError:=ListNotMem
 else begin
      L.ptr:=MemList[L.ptr].next;
      if L.ptr=0 then  ListError:=ListEnd
 end;
end; { MovePtr }

{Procedure EndPtr(var L:List);
Procedure MoveTo(var L:List; N:word);
Procedure DoneList(var L:List);
Procedure CopyList(var L1,L2:List);}<
 br>
end.


STACK8.PAS
Ко д:

unit stack8;
interface
uses list4; {см лаб.раб. №5}
const StackOk=ListOk;
      StackUnder=ListUnder;
      StackOver=ListNotMem;
type stack=list;

procedure InitStack(var s : stack); {инициализация стека}
procedure PutStack(var s : stack; b : basetype);
              
                {поместить элемент в стек}
procedure GetStack(var s : stack; var b : basetype);
                              {извлечь элемент из стека }
function  EmptyStack(s : stack):boolean; {стек пуст}
procedure ReadStack(s:Stack;var b : basetype); {прочитать
                                элемент из вершины стека}
{procedure DoneStack(var s:Stack);}{разрушить стек}
var stackerror:byte;

implementation

Function  NewMem: word;
{воз
 вращает номер свободного элемента, начиная с 1-го
0-й зарезервирован, как недействующий (аналог nil)}
var i:PtrEl;
begin
     i:=1;
     while  MemList[i].Flag and (i<=SizeList) do
        inc(i);
     NewMem:= i;
end;

Procedure DisposeMem(n:PtrEl);
{помечает n-й элемент мас-сива как свободный}
begin
     MemList[n].Flag:=false;
end;

procedure InitStack(var s : stack);
begin
     InitList(s);
end;

procedure PutStack(var s : stack; b : basetype);
var
i:PtrEl;
begin
     i:=NewMem; {находит свободный элемент}
     if i>SizeList
     then stackerror:=ListNotMem
     else begin
          MemList[i].next:=s.start; {ставит его в голову стека}
          MemList[i].Data:=b;
          MemList[i].Flag:=true;
          s.start:=i; {сдвигает на него голову стека}
          inc(s.N);
     end;
end;

procedure GetStack(var s : stack; var b : basetype);
var i:PtrEl;
be
 gin
 if s.start=0 then
   ListError:=ListEnd
 else  begin
     {Запоминается элемент и данные из него.
     Хотя можно обойтись без i
     и подавать в DisposeMem саму s.start }
     i:=s.start;
     b:=MemList[s.start].Data;
     s.start:=MemList[s.start].next;
     DisposeMem(i);
 end;
end;

function  EmptyStack(s : stack):boolean;
begin
     EmptyStack:=EmptyList(s);
end;

procedure ReadStack(s:Stack;var b : basetype);
begin
 if s.ptr=0 then

  ListError:=ListEnd
 else  b:=MemList[s.ptr].Data;
end;

{procedure DoneStack(var s:Stack);}

end.


FIFO9.PAS
Код:

Unit Fifo9;
  
   Interface
Const
  FifoOk   = 0;
  FifoOver = 1;
  FifoUnder= 2;
var  FifoError:0..2;
Type
  TInquiry= record
                  Name: String[10]; {имя запроса}
                  P: Byte; {приоритет}
                  Time1: Word; {время выполнения
                               задачи процессором P1}
                  Time2: Word; {время выполнения
                               задачи процессором P2}
                             end;
  BaseType =  TInquiry;

Const

 FifoSize = 65520  div sizeof(BaseType);
Type
  Index    = 0..FifoSize-1;
  TBuf = array[Index] of BaseType;
  Fifo = record
    PBuf: ^TBuf;
    SizeBuf: word; {количество элементов в массиве}
    Uk1 : Index; {указывает на "голову" очереди}
    Uk2 : Index; {указывает на "хвост" очереди}
end;
procedure InitFifo(var f : fifo; size: word);
                                  {инициализация очереди}
procedu
 re PutFifo(var f : fifo; b : basetype);
                            {поместить элемент в очередь}
procedure GetFifo(var f : fifo; va
r b : basetype);
                             {извлечь элемент из очереди}
function  EmptyFifo(f : fifo):boolean; {очередь пуста}
procedure DoneFifo(var f: fifo);{разрушить очередь}

implementation

procedure InitFifo(var f : fifo; size: word);
var i:integer;
begin
     new(f.PBuf);
     f.SizeBuf:=0;
     f.Uk1:=0;
     f.Uk2:=0;

end;

procedure incFifo(var Uk:Index);
{Сдвиг указателя очереди с учётом перехода через конец массива}
begin
     if Uk<FifoSize

    then inc(Uk)
     else Uk:=0;
end;

procedure PutFifo(var f : fifo; b : basetype);
begin
     if f.SizeBuf>FifoSize
     then FifoError:=FifoOver
     else begin
          inc(f.SizeBuf);
          if f.SizeBuf>1  {при добавлении первого элемента
                           положение указателей менять не надо}
          then incFifo(f.Uk2);
          f.PBuf^[f.Uk2]:=b;
     end;
end;

procedure Ge
 tFifo(var f : fifo; var b : basetype);
begin
     if f.SizeBuf<=0
     then FifoError:=FifoUnder
     else begin
          b:=f.PBuf^[f.Uk1];
          {f.PBuf^[f.Uk1].Name:='';!!!}
          dec(f.SizeBuf);
          if f.SizeBuf>0 then incFifo(f.Uk1);
          {при удалении последнего элемента
          сдвигать уже ничего не надо }
     end;
end;

function  EmptyFifo(f : fifo):boolean; {очередь пуста}
begin
     EmptyFifo:= f.SizeBuf = 0;
end;

procedure
DoneFifo(var f: fifo);{разрушить очередь}
begin
     dispose(f.PBuf);
     f.SizeBuf:=0;
     f.Uk1:=0;
     f.Uk2:=0;
end;

end.


MODEL.PAS
Код:

uses stack8,Fifo9,list4;

const Phigh=0.3; {вероятность получения задач с высоким приоритетом}
      Tinqmax=10; {максимальное время обработки задачи процессором}
      dTg=3; {среднее время выдачи задач генератором}
      Tg=100; {время работы генератора}

type TProc = record
                   inq:TInquiry; {исполняемая задача}
                   pinq:^TInquiry; {указатель для отправки/полчения
                                    задач из
стека}
                   S:stack;
                   Tstart:Word; {время полчения текущей задачи}
             end;

var F1,F2,F3,F4:Fifo; {очереди}
    P1,P2:TProc; {процессоры}
    T:Word; {текущее время}
    r:real;
    G:TInquiry; {задача формируемая генератором}


function RandName(Time:Word):string;
{Формирование имени задачи.}
var i:integer;
    s:string[10];
begin
     str(Time,s); {В начале ставится текущее время
  }
     for i:=length(s)+1 to 10 do
         s:=s + chr(ord('a') + random(26));
     RandName:=s;
end;

procedure PrintFifo(f:fifo);
{Вывод очереди на экран}
var i:integer;
begin
     if f.SizeBuf>0
     then begin
     if f.Uk2>=f.Uk1   {очередь одним куском: голова дальше хвоста }
     then for i:=f.Uk1 to f.Uk2 do
              write(f.PBuf^[i].Name,' ');
     if f.Uk2<f.Uk1  {очередь разделена: на две части }
     then begin
  
       for i:=f.Uk1 to FifoSize-1 do {от хвоста до конца массива}
              write(f.PBuf^[i].Name,' ');
          for i:=0 to f.Uk2 do   {от начала массива до головы}
              write(f.PBuf^[i].Name,' ');
     end;
     end;
     writeln;
end;

procedure PrintStack(s:stack);
{Вывод стека на экран}
var p:^TInquiry;
begin
     BeginPtr(s);
     if ListError=ListOk
     then while ListError<>ListEnd do
 
          begin
               ReadStack(s,pointer(p));
               write(p^.Name,' ');
               MovePtr(s);

          end;
     writeln;
end;

begin
     InitFifo(F1,0);
     InitFifo(F2,0);
     InitFifo(F3,0);
     InitFifo(F4,0);
     InitStack(P1.S);
     P1.Tstart:=65535; {пока не сгенерирована никакая задача,
                        задаётся заведомо большое число }
     P1.inq.Name:='';  {пустая строка в Name -- признак отсутствия задачи}
     InitStack(P2.S);
     P2.Tstart:=65535;
     P2.inq.Name:='';

     T:=0;
     randomize;

    repeat
           {Работа генератора}
           r:=random; {разыгрывается генерирование задачи}
           if T>Tg then r:=1/dTg+1; {если закончилось время
                                    работы генератора}
           if r< 1/dTg
           then begin
                G.Name:=RandName(T);
                G.Time1:=random(Tinqmax)+1;
                G.Time2:=random(Tinqmax)+1;
                r:=random; {разыгрывается приоритет з
 адачи}
                if r < Phigh
                then begin
                     G.P:=0; {высокий приоритет}
                     G.Name[10]:='0'; {приоритет добаляется в имя задачи}
                     PutFifo(F1,G);
                end
                else begin
                     G.P:=1; {низкий приоиртет}
                     G.Name[10]:='1';
                     PutFifo(F2,G);
                end
           end;

           {процессор P1}

          with P1 do
           begin
                {обработка текущей задачи}
                if (inq.Name<>'') and (T>=Tstart + inq.Time1)
                {если в процессоре есть задача и время её обработоки истекло}
                then begin
                     {отправить её в очередь F3 или F4}
                     if inq.P=0 then PutFifo(F3,inq)
                                else PutFifo(F4,inq);
               
       inq.Name:='';
                end;

                if not EmptyFifo(F1)
                {если очередь F1 (с высоким приоритетом) не пуста }
                then begin
                     if (inq.Name<>'') and (inq.P=1)
                     {если в процессоре есть задача с низким приоритетом}
                     then begin
                          {учесть время потарченное на обработку задачи}
                          inq.Time1:=inq.Time1 - (T -
Tstart);
                          {отправить в стек}
                          new(pinq);
                          pinq^:=inq;
                          PutStack(S,pinq);
                          inq.Name:='';
                     end;
                     {если процессор стал свободен}
                     if inq.Name=''
                     then begin
                          GetFifo(F1,inq);
                          
 Tstart:=T;
                     end;
                end;
                {если ни в процессоре ни в очереди F1 не оказалось
                 задачи с высоким приоритетом}
                if inq.Name=''
                then begin
                     {проверить стек}
                     if not EmptyStack(S)
                     then begin
                          GetStack(S,pointer(pinq));
                          inq:=pinq^;
                          dispose(pinq);

                         Tstart:=T;
                     end  {проверить очередь F2}
                     else if not EmptyFifo(F2)
                          then begin
                               GetFifo(F2,inq);
                               Tstart:=T;
                          end;
                end;
           end;

           {процессор P2}
           with P2 do
           begin
                {аналогично процесс
 ору P1}
                if (inq.Name<>'') and (T>=Tstart + inq.Time2)
                then begin
               
      {удаление выполненой задачи}
                     inq.Name:='';
                end;

                if not EmptyFifo(F3)
                then begin
                     if (inq.Name<>'') and (inq.P=1)
                     then begin
                          inq.Time2:=inq.Time2 - (T - Tstart);
                          new(pinq);
                          pinq^:=inq;
                          PutStack(S,pinq);
                          inq.Name:='';

                    end;
                     if inq.Name=''
                     then begin
                          GetFifo(F3,inq);
                          Tstart:=T;
                     end;
                end;

                if inq.Name=''
                then begin
                     if not EmptyStack(S)
                     then begin
                          GetStack(S,pointer(pinq));
 
                          inq:=pinq^;
                          dispose(pinq);
                          Tstart:=T;
                     end
                     else if not EmptyFifo(F4)
                          then begin
                               GetFifo(F4,inq);
                               Tstart:=T;
                          end;
                end;
           end;

           inc(T); {следующий отсчёт времени}

           {Вывод на экран}
   
       writeln('=================');
           writeln('Time ',T);

           writeln('-----------------');
           write('F1   ');
           PrintFifo(F1);

           write('F2   ');
           PrintFifo(F2);

           write('P1.S ');
           PrintStack(P1.S);

           write('P1   ');
           {Вывод оставшегося времени выполнения задачи}
           if P1.
 inq.Name<>'' then write('(',P1.inq.Name,',',(P1.Tstart + P1.inq.Time1) - T,') ');
           writeln;

           writeln('-----------------');
           write('F3   ');
           PrintFifo(F3);

           write('F4   ');
           PrintFifo(F4);

           write('P2.S ');
           PrintStack(P2.S);

           write('P2   ');
           {Вывод оставшегося времени выполнения задачи}

          if P2.inq.Name<>'' then write('(',P2.inq.Name,',',(P2.Tstart + P2.inq.Time2) - T,') ');
           writeln;

           readln;

     {завершение работы после времени Tg и опустошения всех очередей,
      стеков и процессоров}
     until (T>Tg) and EmptyFifo(F1) and EmptyFifo(F2) and EmptyFifo(F3)
           and EmptyFifo(F4) and EmptyStack(P1.S) and EmptyStack(P2.S)
           and (P1.inq.N
 ame='') and (P2.inq.Name='');
end.

Ответ отправил: Сергей Бендер (6-й класс)
Ответ отправлен: 05.12.2010, 20:00
Номер ответа: 264537

Вам помог ответ? Пожалуйста, поблагодарите эксперта за это!
Как сказать этому эксперту "спасибо"?
  • Отправить SMS #thank 264537 на номер 1151 (Россия) | Еще номера »
  • Отправить WebMoney:

    • Оценить выпуск »
    Нам очень важно Ваше мнение об этом выпуске рассылки!

    Задать вопрос экспертам этой рассылки »

    Скажите "спасибо" эксперту, который помог Вам!

    Отправьте СМС-сообщение с тестом #thank НОМЕР_ОТВЕТА
    на короткий номер 1151 (Россия)
    Номер ответа и конкретный текст СМС указан внизу каждого ответа.

    Полный список номеров »

    * Стоимость одного СМС-сообщения от 7.15 руб. и зависит от оператора сотовой связи. (полный список тарифов)
    ** При ошибочном вводе номера ответа или текста #thank услуга считается оказанной, денежные средства не возвращаются.
    *** Сумма выплаты эксперту-автору ответа расчитывается из суммы перечислений на портал от биллинговой компании.

    © 2001-2010, Портал RFPRO.RU, Россия
    Авторское право: ООО "Мастер-Эксперт Про"
    Автор: Калашников О.А. | Программирование: Гладенюк А.Г.
    Хостинг: Компания "Московский хостер"
    Версия системы: 2010.6.24 от 30.11.2010
    В избранное