Транспортная задача по критериям стоимости и времени

Автор: Пользователь скрыл имя, 03 Марта 2013 в 18:50, курсовая работа

Краткое описание

Имеется пунктов отправления, в каждом из которых сосредоточено определенное количество единиц однородного продукта, предназначенного к отправке: в первом пункте имеется единиц этого продукта, во втором - единиц, в м пункте единиц, и, наконец, в м пункте единиц продукта. Этот продукт следует доставить в пунктов назначения (потребления), причем в первый пункт назначения следует доставить единиц продукта, во второй - единиц, в й пункт единиц, и, наконец, в й пункт единиц продукта.

Оглавление

1. Постановка задачи 3
2. Обоснование математической модели 4
3. Краткие сведения о методе решения задачи 5
Сведение открытой модели транспортной задачи к открытой 5
Метод минимального элемента 6
Метод потенциалов: 6
4. Проверка достоверности полученных результатов 9
5. Алгоритм решения задачи 10
6. Листинг программы, реализующий алгоритм задачи 11
7. Руководство пользователя 21
7.1 Системные требования 21
7.2 Описание возможностей 21
7.3 Использование 21
7.4 Использование инженерного режима 24
8. Решение задачи курсовой работы на ПЭВМ по исходным данным индивидуального варианта 25
9. Список использованной литературы 28

Скачать в ZIP (357.77 Кб) Сколько стоит заказать работу?

Файлы: 1 файл

Курсовой проект - Транспортная задача по критериям стоимости и времени. Вариант 3.1.docx

— 441.34 Кб (Скачать)

Далее строят матрицу Ck+1. Для этого наибольший по модулю отрицательней элемент матрицы Ck прибавляют ко всем выделенным столбцам и вычитают из всех выделенных строк матрицы Ck. При этом все выделенные Xk-существенные элементы матрицы Ck остаются равными нулю.

Если  все элементы матрицы Ck+1 окажутся неотрицательными, то Xk— оптимальный план, и на этом процесс заканчивается. В противном случае переходят ко второму этапу.

Второй этап. Производят улучшение плана Хk. Выбирают наибольший по модулю отрицательный элемент матрицы Ck+1. Затем составляют, применив, например метод вычеркивания, цепочку из положительных элементов плана Xk, которая замыкается на выбранном элементе.

После того как цепочка построена, в ней  находят минимальный нечетный по порядку следования элемент и  прибавляют его ко всем четным элементам  цепочки и вычитают из всех нечетных элементов. Остальные элементы Xk оставляют без изменения.

Новый план Xk+1.построен. Он является опорным, так как число его ненулевых перевозок не изменилось.

 

4. Проверка достоверности полученных результатов

 

В общем  случае проверка полученных результатов после очередной итерации вычисления осуществляется следующим образом:

Целевая функция считается 2 способами:

    2.  Пусть минимальным элементом матрицы С(k) оказался элемент с индексами μ, κ, тогда значение целевой функции на этом шаге будет равно:

Если  значения не совпадают то, то на экран выводится ошибка.

Если  условие  выполняется, то полученный результат (на данной итерации) достоверен.

 

При выполнении дооптимизации  единственным подтверждением правильности результатов может служить уменьшение целевой функции .

 

5. Алгоритм решения задачи

  1. Проверка правильности ввода данных.
  2. Проверка условия баланса.
  3. Построение начального опорного плана Х(0) методом минимального элемента.
  4. Проверка плана на вырожденность, если нужно добавляем фиктивные перевозки.
  5. Расчет начальных потенциалов и заполнение матрицы С(1).
  6. Поиск минимального элемента в матрице С(1).
  7. Если этот элемент меньше нуля, то заменяем нулевой элемент, соответствующий минимальному в С(1), в плане Х(0) на фиктивную перевозку, иначе на пункт 12.
  8. Производим процедуру вычеркивания.
  9. Оставшиеся не вычеркнутыми элементы разделяем на четные и нечетные, учитывая, что добавленный элемент принадлежит к четным.
  10. Находим минимальный нечетный элемент и прибавляем его ко всем четным и отнимаем от нечетных элементов. Причем, если минимальных элементов окажется 2 или более, то один из них обнуляем, а остальные делаем фиктивными. В итоге получаем план Х(1).
  11. Производим процедуру вычеркивания. Получаем матрицу С(2).
  12. Проверяем матрицу С(2) на наличие отрицательных элементов. Если такие элементы присутствуют, то повторяем пункты с 5 по11.
  13. Если во время решения достоверность результатов нарушается, прекращаются дальнейшие вычисления, пользователю выдается информация об ошибке.
  14. Дооптимизация по времени.
    1. Ищем отличный от нуля элемент в матрице X(k), которому соответствует наибольший элемент матрицы Т=tmax.
    2. Ищем в матице С(k) нули соответствующие таким нулям в матрице X(k), что соответствующие им элементы матрицы Т меньше tmax.
    3. Если в предыдущем пункте нашелся хоть один ноль, то производим процедуры пунктов 7-10.
    4. Переходим к пункту 14.1.
  15. Вывод результатов.

 

6. Листинг программы, реализующий алгоритм задачи

const

  color=TColor(Clred);

var i,j,v,w:integer;

  err,kon:boolean;

  str:String;

begin

kon:=true;

Label3.Caption:='';

for j:=1 to StringGrid1.RowCount-1 do

   if (StringGrid1.Cells[1,j]='')or(StringGrid1.Cells[0,j]='')then

     kon:=false;

for j:=1 to StringGrid2.RowCount-1 do

   if (StringGrid2.Cells[1,j]='')or(StringGrid2.Cells[0,j]='')then

     kon:=false;

if kon=true then

  begin

  err:=true;

  for j:=1 to StringGrid1.RowCount-1 do

   begin

    Str:=Trim(StringGrid1.Cells[1,j]);

     Recurs(str,1,err);

     If err=false then

     begin

      StringGrid1.Canvas.Brush.color := color;

      StringGrid1.canvas.fillRect(StringGrid1.CellRect(1,j));

      StringGrid1.canvas.TextOut(StringGrid1.CellRect(1,j).Left,StringGrid1.CellRect(1,j).Top,StringGrid1.Cells[1,j]);

      Label3.Caption:= ’Выделенные значения не верны';

     end;

     Err:=true;

   end;

  for j:=1 to StringGrid2.RowCount-1 do

   begin

    Str:=Trim(StringGrid2.Cells[1,j]);

     Recurs(str,1,err);

     If err=false then

     begin

      StringGrid2.Canvas.Brush.color := color;

      StringGrid2.canvas.fillRect(StringGrid2.CellRect(1,j));

      StringGrid2.canvas.TextOut(StringGrid2.CellRect(1,j).Left,StringGrid2.CellRect(1,j).Top,StringGrid2.Cells[1,j]);

      Label3.Caption:= ‘Выделенные значения не верны';

     end;

     Err:=true;

   end;

  for j:=1 to StringGrid1.RowCount-1 do

   begin

    Str:=Trim(StringGrid1.Cells[1,j]);

     Recurs(str,1,err);

    end;

  for j:=1 to StringGrid2.RowCount-1 do

   begin

    Str:=Trim(StringGrid2.Cells[1,j]);

    Recurs(str,1,err);

   end;

   If err=true then

    begin

    for j:=1 to StringGrid1.RowCount-1 do

       begin

         If (StrToInt(trim(StringGrid1.Cells[1,j]))<0)or(StrToInt(trim(StringGrid1.Cells[1,j]))>190)

          then

           begin

           StringGrid1.Canvas.Brush.color := color;

           StringGrid1.canvas.fillRect(StringGrid1.CellRect(1,j));

           StringGrid1.canvas.TextOut(StringGrid1.CellRect(1,j).Left,StringGrid1.CellRect(1,j).Top,StringGrid1.Cells[1,j]);

           err:=false;

           Label3.Caption:= ‘Выделенные значения не верны';

          end;

       end;

    for j:=1 to StringGrid2.RowCount-1 do

       begin

         If (StrToInt(trim(StringGrid2.Cells[1,j]))<0)or(StrToInt(trim(StringGrid2.Cells[1,j]))>160)

          then

           begin

           StringGrid2.Canvas.Brush.color := color;

           StringGrid2.canvas.fillRect(StringGrid2.CellRect(1,j));

           StringGrid2.canvas.TextOut(StringGrid2.CellRect(1,j).Left,StringGrid2.CellRect(1,j).Top,StringGrid2.Cells[1,j]);

           err:=false;

           Label3.Caption:= ‘Выделенные значения не верны';

          end;

       end;

  if err=true then

   begin

    w:=0;//ai

     v:=0;//bj

    SetLength(c,StringGrid2.RowCount-1,StringGrid1.RowCount-1);

    SetLength(t,StringGrid2.RowCount-1,StringGrid1.RowCount-1);

    SetLength(a,StringGrid1.RowCount-1);

    SetLength(b,StringGrid2.RowCount-1);

     //Проверка условия баланса

     For i:=1 to StringGrid1.RowCount-1 do

       w:=w+StrToint(Trim(StringGrid1.cells[1,i]));

     For i:=1 to StringGrid2.RowCount-1 do

       v:=v+StrToint(Trim(StringGrid2.cells[1,i]));

     if w<v then

       begin

        Setlength(c,(StringGrid2.RowCount-1),(StringGrid1.RowCount));

        SetLength(a,StringGrid1.RowCount);

        for i:=0 to Length(c)-1 do

         begin

          c[i,Length(c[1])-1]:=1000;

         end;

        a[length(a)-1]:=v-w;

       end;

     if w>v then

       begin

        Setlength(c,(StringGrid2.RowCount),(StringGrid1.RowCount-1));

          SetLength(b,StringGrid2.RowCount);

        for i:=0 to Length(c[1])-1 do

         begin

          c[length(c)-1,i]:=1000;

         end;

        b[length(b)-1]:=w-v;

       end;

     For i:=0 to StringGrid1.RowCount-2 do

        a[i]:=StrtoInt(Trim(StringGrid1.cells[1,i+1]));

     For i:=0 to StringGrid2.RowCount-2 do

        b[i]:=StrtoInt(Trim(StringGrid2.Cells[1,i+1]));

    For i:=1 to StringGrid1.RowCount-1 do

        begin

        Form3.StringGrid1.Cells[0,i]:=StringGrid1.cells[0,i];

        Form3.StringGrid2.Cells[0,i]:=StringGrid1.cells[0,i];

        end;

    For i:=1 to StringGrid2.RowCount-1 do

       begin

        Form3.StringGrid1.Cells[i,0]:=StringGrid2.cells[0,i];

        Form3.StringGrid2.Cells[i,0]:=StringGrid2.cells[0,i];

       end;

       Form3.Show;

       Form5.Close;

    end;

   end;

   end

  else ShowMessage('Заполните все поля');

procedure Potencial(x:Tmatr; u,v:Tmas; var z:Tmatr );

var

  i,j,k,r:integer;

begin

   SetLength(u,length(x[1]));

   SetLength(v,Length(x));

   For r:=0 to Length(x)-1 do

    v[r]:=-1000;

   for j:=0 to Length(x[1])-1 do

    u[j]:=-1000;

   u[0]:=0;

   For r:=0 to Length(x)-1 do

   for j:=0 to Length(x[1])-1 do

   begin

    for i:=0 to Length(x)-1 do

     if (x[i,j]<>0) and (v[i]=-1000)then

      if (u[j]<>-1000)then

        v[i]:=c[i,j]+u[j];

     For i:=0 to Length(x)-1 do

      if v[i]<>-1000 then

       for k:=0 to Length(x[1])-1 do

        if (k<>j)and(x[i,k]<>0)and(u[k]=-1000)then

         u[k]:=v[i]-c[i,k];

   end;

    Setlength(z,Length(c),Length(c[1]));

   For i:=0 to Length(x)-1 do

    For j:=0 to Length(x[1])-1 do

     z[i,j]:=c[i,j]-(v[i]-u[j]);

end;

//Проверкана вырожденость

procedure Virogden(var x:Tmatr);

var i,j,r,k,d:integer;

  h,g:boolean;

begin

  d:=0;

   For i:=0 to Length(x)-1 do

    for j:=0 to length(x[1])-1 do

     if x[i,j]<>0 then d:=d+1;

    if d<Length(x)+Length(x[1])-1 then

     For i:=0 to Length(x)-2 do

      for j:=0 to Length(x[1])-2 do

       begin

        if x[i,j]>0 then

         begin

           h:=true;

           g:=true;

          for r:=i+1 to Length(x)-1 do

           if x[r,j]>0 then

            h:=false;

          for k:=j+1 to Length(x[1])-1 do

           if x[i,k]>0 then

            g:=false;

          if(h=true)and(g=true) then

           x[i,j+1]:=-2;

         end;

       end;

end;

 

procedure Opornplan(StringGrid1:TStringGrid; var x,z:Tmatr);

var i,j:integer;

c1:TMatr;

begin

  Setlength(x,Length(c),Length(c[1]));

  Setlength(c1,Length(x)*Length(x[1]),3);

  For i:=0 to Length(x)-1 do

    for j:=0 to Length(x[1])-1 do

     begin

        c1[(Length(x[1]))*i+j,0]:=c[i,j];

        c1[(Length(x[1]))*i+j,1]:=i;

        c1[(Length(x[1]))*i+j,2]:=j;

     end;

  Setlength(z,1,3);

  //Сортировка

  For i:=0 to Length(c1)-2 do

   for j:=0 to Length(c1)-2 do

    if c1[j,0]>c1[j+1,0] then

     begin

      z[0]:=c1[j+1];

      c1[j+1]:=c1[j];

      c1[j]:=z[0];

     end;

  for i:=0 to Length(x)-1 do

   for j:=0 to Length(x[1])-1 do

    x[i,j]:=-1;

  For i:=0 to Length(x)*Length(x[1])-1 do

   if x[c1[i,1],c1[i,2]]=-1 then

    begin

    //Если à>b

     If a[c1[i,2]]>b[c1[i,1]] then

      begin

        x[c1[i,1],c1[i,2]]:=b[c1[i,1]];

        For j:=0 to Length(x[1])-1 do

         If x[c1[i,1],j]=-1 then

         x[c1[i,1],j]:=0;

       a[c1[i,2]]:=a[c1[i,2]]-b[c1[i,1]];

       b[c1[i,1]]:=0;

      end;

    //Если b>a

    If a[c1[i,2]]<b[c1[i,1]] then

      begin

        x[c1[i,1],c1[i,2]]:=a[c1[i,2]];

        For j:=0 to Length(x)-1 do

        if x[j,c1[i,2]]=-1 then

         x[j,c1[i,2]]:=0;

      b[c1[i,1]]:=b[c1[i,1]]-a[c1[i,2]];

      a[c1[i,2]]:=0;

      end;

     //Если равны

     If a[c1[i,2]]=b[c1[i,1]] then

      begin

        x[c1[i,1],c1[i,2]]:=a[c1[i,2]];

        For j:=0 to Length(x[1])-1 do

        if x[c1[i,1],j]=-1 then

         x[c1[i,1],j]:=0;

        For j:=0 to Length(x)-1 do

         If x[j,c1[i,2]]=-1 then

         x[j,c1[i,2]]:=0;

       a[c1[i,2]]:=0;

       b[c1[i,1]]:=0;

      end;

    end;

   //Проверка на вырожденность

   Virogden(x);

   potencial(x,u,v,z);

end;

 

procedure Vicherk(var z:TMatr;var err:boolean);

var i,j,min,k:integer;

w,d:Tmas;

begin

SetLength(w,Length(z));

SetLength(d,Length(z[1]));

min:=z[0,0];

k:=0;

For i:=0 to length(w)-1 do

  for j:=0 to length(d)-1 do

    if z[i,j]<min then

     begin

      min:=z[i,j];

      k:=j;

     end;

for i:=0 to length(w)-1 do

   if (z[i,k]=0)and(x[i,k]<>0) then

       w[i]:=5;

     d[k]:=-1;

For k:=0 to length(d)*Length(w)-2 do

begin

for i:=0 to Length(w)-1 do

    if w[i]>0 then

      begin

       for j:=0 to Length(d)-1 do

        if (z[i,j]=0)and(x[i,j]<>0)and(d[j]<>-1) then

         d[j]:=5;

        w[i]:=-1;

       end;

  For j:=0 to Length(d)-1 do

    if d[j]>0 then

     begin

       for i:=0 to Length(w)-1 do

          if (z[i,j]=0)and(x[i,j]<>0)and(w[i]<>-1) then

           w[i]:=5;

           d[j]:=-1;

        end;

end;

For i:=0 to length(d)-1 do

if d[i]=-1 then

  for j:=0 to length(w)-1 do

   z[j,i]:=z[j,i]+abs(min);

for i:=0 to Length(w)-1 do

if w[i]=-1 then

  for j:=0 to length(d)-1 do

   z[i,j]:=z[i,j]-abs(min);

err:=true;

i:=0;j:=0;

Repeat

j:=0;

  Repeat

   if z[i,j]<0 then

    err:=false;

  j:=j+1;

  until (err=False)or(j=Length(z[1]));

  i:=i+1;

until (err=false)or(i=Length(z));

end;

 

procedure Cikle (l,r:integer ; var x:Tmatr);

var i,j,k,min:integer;

  s,q,m,n:Tmatr;

  kon:boolean;

begin

   //Добавляем на соответствующее место фиктивную перевозку

   x[l,r]:=-2;

   Setlength(s,Length(x),Length(x[1]));

    For i:=0 to Length(x)-1 do

      For j:=0 to Length(x[1])-1 do

       s[i,j]:=x[i,j];

   //ищем цикл в матрице

   Repeat

     kon:=true;

     for i:=0 to length(s)-1 do

      begin

       k:=0;

        For j:=0 to length(s[1])-1 do

          if s[i,j]<>0 then

            k:=k+1;

        if k=1 then

          begin

            for j:=0 to length(s[1])-1 do

             s[i,j]:=0;

            kon:=false;

          end;

      end;

      for i:=0 to length(s[1])-1 do

       begin

        k:=0;

        For j:=0 to length(s)-1 do

         if s[j,i]<>0 then

           k:=k+1;

        if k=1 then

         begin

          for j:=0 to length(s)-1 do

            s[j,i]:=0;

          kon:=false;

        end;

       end;

   until kon=true;

   k:=0;

   //Записываем элементы цикла в масив

   For i:=0 to Length(s)-1 do

    for j:=0 to Length(s[1])-1 do

     if s[i,j]<>0 then

      k:=k+1;

   SetLength(q,k,3);

   k:=0;

   For i:=0 to Length(s)-1 do

    for j:=0 to Length(s[1])-1 do

     If s[i,j]<>0 then

      begin

       q[k,0]:=s[i,j];

       q[k,1]:=i;

       q[k,2]:=j;

       k:=k+1;

      end;

//Разделяем на четные и нечетные

  Setlength(n,Round(k/2),3);

  Setlength(m,Round(k/2),3);

  n[0,0]:=q[0,0];

  n[0,1]:=q[0,1];

  n[0,2]:=q[0,2];

  q[0,0]:=0;

For j:=0 to length(n)-1 do

begin

  i:=0;

  kon:=false;

  repeat

   if i<=Length(q)-1 then

   begin

    If (q[i,0]<>0)and(q[i,1]=n[j,1]) then

     begin

      m[j,0]:=q[i,0];

      m[j,1]:=q[i,1];

      m[j,2]:=q[i,2];

      q[i,0]:=0;

      kon:=true;

     end;

     i:=i+1;

   end

   else kon:=true;

  until kon=true;

  i:=0;

  kon:=false;

  repeat

   if i<=Length(q)-1 then

   begin

    If (q[i,0]<>0)and(q[i,2]=m[j,2]) then

     begin

      n[j+1,0]:=q[i,0];

      n[j+1,1]:=q[i,1];

      n[j+1,2]:=q[i,2];

      q[i,0]:=0;

      kon:=true;

     end;

     i:=i+1;

   end

   else kon:=true;

  until kon=true;

  end;

    i:=0;

    repeat

     if (n[i,0]=s[l,r])and(n[i,1]=l)and(n[i,2]=r)then

      kon:=false

     else kon:=true;

     i:=i+1;

    until (i>length(n)-1)or(kon=false);

  if kon=true then

   for i:=0 to length(n)-1 do

    begin

     q[i,0]:=m[i,0];

     q[i,1]:=m[i,1];

     q[i,2]:=m[i,2];

     m[i,0]:=n[i,0];

     m[i,1]:=n[i,1];

     m[i,2]:=n[i,2];

     n[i,0]:=q[i,0];

     n[i,1]:=q[i,1];

     n[i,2]:=q[i,2];

    end;

  min:=m[0,0];

  kon:=false;

  i:=0;

//Ищем минимальный среди нечетных

  repeat

   if m[i,0]<min then

    begin

     min:=m[i,0];

    end;

   if m[i,0]=-2 then

    begin

     m[i,0]:=0;

     min:=0;

     kon:=true;

    end;

   i:=i+1;

  until (kon=true)or(i>=length(m));

  kon:=false;

  i:=0;

  repeat

   if m[i,0]=min then

    begin

     m[i,0]:=0;

     kon:=true;

    end;

     i:=i+1;

  until (kon=true)or(i>=length(m));

   if min>0 then

    begin

     for i:=0 to length(m)-1 do

      if m[i,0]=min then m[i,0]:=-2

      else

      if m[i,0]<>0 then

        m[i,0]:=m[i,0]-min;

     for i:=0 to Length(n)-1 do

       if n[i,0]=-2 then n[i,0]:=min

       else n[i,0]:=n[i,0]+min;

    end;

  for i:=0 to Length(m)-1 do

   begin

    x[m[i,1],m[i,2]]:=m[i,0];

    x[n[i,1],n[i,2]]:=n[i,0];

   end;

end;

 

Procedure Dooptimiz(var max2:integer; var x:Tmatr);

var i,j,k,l,r,max:integer;

kon,err:boolean;

q:TMatr;

s:Tmatr;

begin

   kon:=true;

   SetLength(s,Length(t),Length(t[1]));

 

   max2:=0;

   for i:=0 to Length(t)-1 do

     For j:=0 to Length(t[1])-1 do

       s[i,j]:=x[i,j];

   Repeat

   err:=true;

   max:=0;k:=0;

   SetLength(q,0,0);

   for i:=0 to Length(t)-1 do

     For j:=0 to Length(t[1])-1 do

      If (s[i,j]>0)and(t[i,j]>max) then

       begin

        max:=t[i,j];

        l:=i;

        r:=j;

       end;

   for i:=0 to Length(t)-1 do

     For j:=0 to Length(t[1])-1 do

      If (z[i,j]=0)and(s[i,j]=0) then

Информация о работе Транспортная задача по критериям стоимости и времени

Связанные документы

Транспортная задача

Транспортная задача

Транспортная задача

Транспортная задача

Задачи транспортной логистики

Задачи транспортной логистики

Моделирование транспортной задачи

Решение транспортной задачи

Решение транспортной задачи

Транспортная задача. Метод потенциалов

Концепция стоимости денег во времени

Концепция стоимости денег во времени

Похожие темы

Временная стоимость денег

Постановка транспортной задачи

Сущность и задачи транспортной логистики