Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 23.10.2013, 18:05   #1
katerina17171
Пользователь
 
Регистрация: 23.06.2011
Сообщений: 15
По умолчанию Поток отказов

нужно отфильтровывать заявки по потоку Эрланга 2-го рода отказа
Код:
unit MAIN;

interface

uses Windows, Classes, Graphics, Forms, Controls, Menus,
  Dialogs, StdCtrls, Buttons, ExtCtrls, ComCtrls, ImgList, StdActns,
  ActnList, ToolWin,SysUtils,Math;

type
  TMainForm = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    EditLimitWork: TEdit;
    Label3: TLabel;
    ListBox1: TListBox;
    Label4: TLabel;
    EditLimitWait: TEdit;
    Button1: TButton;
    Label5: TLabel;
    Editintensity: TEdit;
    Label6: TLabel;
    EditLeft: TEdit;
    Label7: TLabel;
    EditRight: TEdit;
    Label8: TLabel;
    EditDen: TEdit;
    procedure Button1Click(Sender: TObject); //указатель на тип TClient

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;


implementation

{$R *.dfm}

  type
    TPClient = ^TClient; //указатель на тип TClient

    TClient = record
      timeArrive: real; //время прихода в систему
      next: TPClient; // следующий элемент списка
    end;

  var
  a0,b0,c0,z,z0:real;
  head: TPClient;
  timeLimitWork:real; //время работы системы
  timeLimitWait:real; //время ожидания заявки
  timeLeft:real;
  timeRight:real;
  intensity:real;
  verDen:real;

  procedure Insert(x:real); //процедура вставки в список(время ожидания)
  var
    p,temp:TPClient;
  begin
    new(p);
    p^.timeArrive:=x;
    p^.next:=nil;
    if head = nil then
    begin
      head:=p;
      head^.next:=nil;
    end
    else
    begin
      temp:=head;
      while (temp^.next <> nil) do
        temp:=temp^.next;
      temp^.next:=p;
    end;
  end;

  procedure Delete(); //удаление из списка
  var
    temp:TPClient;
  begin
    if(head<>nil) then
    begin
      temp:=head;
      head:=head^.next;
      temp^.next:=nil;
      Dispose(temp);
    end;
  end;


  procedure clear();
  begin
    while(head<>nil) do
      Delete();
  end;

  function getRandom():real;  //ГПСЧ
  begin
    z := (a0 * z0 + b0) / c0;
    z0 := z;
    getRandom:=(z/c0)*1000000000000;
  end;


  function ex(l:real):real; //простейший поток(интенсивность) на основе экспоненциального распределения
  var
    x:real;
  begin
    x:=getRandom();
    ex:=-Ln(1-x)/l; //return -Math.Log(1 - GetRandom()) / l;
  end;


  procedure Gauss(var res:real;left:real; right: real);  //усеченное распределение(левая,правая);
  var
    U1,S2,Mx,Sigma: real;
  begin
    Mx:=(left+right)/2;
    Sigma := (right-Mx)/3;
  repeat
    U1 := 2*Random - 1;
    S2 := Sqr(U1) + Sqr(2*Random-1);
  until S2 < 1;
  res := Sqrt(-2*Ln(S2)/S2) * U1 * Sigma + Mx;
end;

  procedure prepare();  //формирование очереди заявок по заданному распределению
  var
     temp:real;
     timeArrive:real;
  begin
    a0 := 214013; //величины
    b0 := 2531011;    //для
    c0 := 4294967296; //базового ГПСЧ
    timeLimitWork:=StrToFloat(MainForm.EditLimitWork.Text);
    timeLimitWait:=StrToFloat(MainForm.EditLimitWait.Text);
    intensity:=StrToFloat(MainForm.Editintensity.Text);
    timeLeft:=StrToFloat(MainForm.EditLeft.Text);
    timeRight:=StrToFloat(MainForm.EditRight.Text);
    verDen:=StrToFloat(MainForm.EditDen.Text);

    //формирование очереди клиентов
    timeArrive:=0;
    repeat
      Insert(timeArrive);
      timeArrive:=timeArrive+ex(intensity);
    until (timeArrive>timeLimitWork);
  end;

  procedure run();
  var
     timeModeling:real;
     timeWork:real;
     count_client:integer;
     time_last_client:real;
  begin
    MainForm.ListBox1.Items.Add('Начало моделирования');
    timeModeling:=0;
    count_client:=0;
    time_last_client:=0;

    while ((timeModeling <= timeLimitWork) and (head <>nil)) do
    begin
      if(head<>nil) then
      begin
        inc(count_client);
        if(timeModeling - head^.timeArrive<=timeLimitWait) then
        begin
        //берем клиента и увеличиваем время моделирование на время работы
          Gauss(timeWork,timeLeft,timeRight);
          if(timeModeling>=head^.timeArrive) then timeModeling:=timeModeling+timeWork
          else timeModeling:=timeModeling+head^.timeArrive+timeWork;
          if timeModeling<timeLimitWork then
          begin
          //  inc(count_client);
            MainForm.ListBox1.Items.Add('Клиент '+IntToStr(count_client)+' появился в системе в '+FloatToStr(head^.timeArrive)+' обслужан в '+FloatToStr(timeModeling)+' за '+FloatToStr(timeWork));
            Delete; //убираем клиента
          end;
        end
        else
        begin
       //   inc(count_client);
          MainForm.ListBox1.Items.Add('Привышено время ожидания клиента '+IntToStr(count_client)+' пришедшего в '+FloatToStr(head^.timeArrive));
          Delete;
        end;
    end;
    end;
  end;


procedure TMainForm.Button1Click(Sender: TObject);
begin
  clear();
  prepare();
  run();
end;

end.

Последний раз редактировалось Stilet; 23.10.2013 в 18:09.
katerina17171 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Класс запускает поток, который заполняет этот класс. Обмен класс <=> поток. Человек_Борща Общие вопросы Delphi 8 27.02.2012 23:24
Программа, выполняющая поиск отказов в выписках (в формате RTF) и формирующая реестр отказников в формате XLS (на делфи) avtoritetbikov@mai Фриланс 5 08.11.2011 00:20
поиск отказов в выписках (в формате RTF) и формирующую реестр отказников в формате XLS avtoritetbikov@mai Фриланс 3 03.10.2011 09:03
Поток. Не получается создать поток. Выдает ошибки при запуске bigory Общие вопросы по Java, Java SE, Kotlin 3 23.09.2010 00:40
Рейтинг отказов видокарт mihali4 Компьютерное железо 2 21.03.2009 18:49