Решение транспортной задачи закрытого типа методом «наименьшей стоимости»

 

Информационные средства:

Для нормального функционирования программы достаточно иметь информационную систему MS DOS

 

Типы переменных, используемые в программе:

Const n=7 (строки и столбцы)

A: array [1..n] of integer; {массив запасов}

B: array [1..n] of integer; {массив потребностей}

Alfa: array [1..n] of integer; {массив потенциалов альфа}

Betta: array [1..n] of integer; {массив потенциалов бетта}

B_d: array [1..n] of integer;   {массив удельных стоимостей перевозок}

X: array [1.n, 1..n] of integer; {основной массив, в который производится запись базисного решения}

F,f0,x_min,Sp,tt: integer;

Nt,x_p,r,r_min,ki,kj,Na,Nb,h,l,i,j:byte;

D, ch: char; 

 

 

Процедуры:

1. Procedure Nul      {Обнуляется массив}
2. Procedure PrintS    {Вывод строки S}
3. Procedure Print {Вывод числа A}
4. Procedure Rid {Процедура ввода числа X}
5. Procedure goriz   {Процедура goriz выводят таблицу}
6. Procedure wertic {Процедура  wertic выводят таблицу}
7. Procedure Tabl  {Процедура  Tabl выводят таблицу}   
8. Procedure W_W {Ввод в таблицу кол-ва продукции поставщиков и потребителей}
9. Procedure W_p  {Вывод плана распределения}
10. Procedure div_mod {Перевод одномерного массива в двухмерный}
11. Procedure Rek {Рекурсивная процедура определяет контур перемещения}
12. Procedure kontur; {Определяет контур перемещения}
13. Procedure Pauza;

Функции:

1. Function FF  {Вычисление стоимости плана}
2. Function a_b  {Расчёт потенциалов alfa и betta}
3. Function KKK {Расчёт коэффициентов в свободных клетках}

 

 

 

 

 

 

 

 

 

 

ЗАКЛЮЧЕНИЕ

Главной целью данной курсовой работы является нахождение оптимального плана перевозок груза  от поставщика к потребителям.

Мне была поставлена задача, составить программу для решения транспортной задачи методом учета наименьших стоимостей. В данной работе используется общий алгоритм решения подобных задач, так как он является наиболее простым и удобным для использования при программировании.

В процессе разработки курсового  проекта была составлена универсальная  программа для решения аналогичных задач.

Программа реализована  в среде программирования Borland Pascal. В программе удобный и понятный пользовательский интерфейс. Данные вводятся с клавиатуры. Все вводимые данные вводятся в виде таблицы.

Правильность работы программы определяется с помощью  задачи-теста, для проверки правильности работы программы были заданы: количество поставщиков и потребителей, наличие  груза, заявки и тарифы перевозок. Результаты были посчитаны в ручную, и их ответы совпадают с ответами программы.

В исходную программу  могут быть внесены изменения: в  описании массива данных увеличить  размерность массива и тогда  программа будет работать с большим диапазоном данных.

Таким образом, поставленная задача была выполнена.

 

 

 

 

 

 

 

 

 

СПИСОК ИСПОЛЬЗОВАННЫХ ИСТОЧНИКОВ

1. В.В. Фаронов. Турбо Паскаль. Начальный курс. Учебное пособие.
2. В.В. Федосеев. Экономико-математические методы и прикладные модели. Учебное пособие для ВУЗов. 2002г.
3. Ю.М. Коршунов. Математические основы кибернетики. Учебное пособие для ВУЗов. 1987 год.
4. Н.В. Максимов., Т.Л. Партыка, И.И. Попов, Архитектура ЭВМ и вычислительных систем. Учебник. 2005. 512с.

5. В.И. Ермаков. Общий курс высшей математики для экономистов. 656 с.

6. А.В. Кузнецов, В.А. Сакович, Н.И. Холод. Сборник задач и упражнений по высшей математике: математическое программирование. Учебник пособие. 2002. 447с.
7. Т.Л. Партыкина, И.И. Попов. Математические методы. Учебник. 2005. 464 с.
8. И.Г. Семакин. Основы программирования. Учебник для сред. проф. Образования. 2003. 432 с.
9. В.В. Федосеев и др. Экономико-математические методы и прикладные модели. Учебное пособие для ВУЗов. 2002.
10. А.В. Кузнецов и др. Сборник задач и упражнений по высшей математике и математическому программированию. Учебное пособие. 2002.
11. Ю.М. Коршунов. Математические основы кибернетики. Учебное пособие для ВУЗов. 1987.

 

ПРИЛОЖЕНИЕ (ЛИСТИНГ ПРОГРАММЫ)

Program tr_zadacha;

Uses CRT;

Label l1;

Const N=6;

      n1=7; n2=7;

      SA: integer=0;

      Sb: integer=0;

Type massiw=Array [1..N] of integer;

     Rasp=Array [1..N, 1..N] of integer;

Var A, B, alfa, betta, B_d, x: massiw;

    C, p: rasp;

    F, f0, x_min, Sp, tt: integer;

    Nt,x_p,r,r_min,ki,kj,Na,Nb,h,l,i,j:byte;

    D, ch: char; 

    U: Array [1..N*N] of byte;

Procedure Nul (Var a: massiw);       {Обнуляется массив}

Var i: byte; 

Begin

     For i: =1 to N do a[i]:=0;

End;

Procedure PrintS (x, y: byte; s: string; c: byte);

Begin                                  {Вывод строки S}

     TextColor(c);

     GotoXY(x, y);

     Write(s);

End;

Procedure Print (x, y: byte; n: byte; a: integer; c: byte);

Begin                                {Вывод числа A}

     TextColor (1);

     GotoXY(x, y); Write (' ': n);

     GotoXY(x, y); Write (a);

End;

Procedure Rid (Var x: integer; y: byte); {Процедура ввода числа X}

Var i: integer;

    S: string;

    C: char;

    J, k: byte;

Begin

     S: =''; i: =1;

     TextColor (11);

     Repeat

           C: =ReadKey;

           Case ord(c) of

48..57:         begin s:=s+c;

                      Write(c);

                      Inc (i);

                End;

8:              if i>1 then begin dec (i);

                      Delete(s, i, 1);

                      Write (chr (8),' ', Chr (8));

                End;

           End;

           J: =WhereX;

           GotoXY (60, 1); ClrEOL;

           If i>y then begin

              TextColor (4);

              Write ('Не более');

              For k: =1 to y-1 do Write ('9');

              TextColor (11);

           End;

           GotoXY (j, 1);

     Until (ord(c) =13) and (i<y+1);

     Val(s, x, i);

End;

Procedure goriz (a, b, c, d, e: char);   {Процедура goriz, wertic}

Var i, j: byte;                          {и Tabl выводят таблицу}

Begin

     Write (a);

     For i: =1 to n2 do Write (b);

     Write(c);

     For i: =1 to Nb do begin

         For j: =1 to n1 do Write (b);

         If i<>Nb then Write (d) else Write(c);

     End;

     For i: =1 to 4 do Write (b);

     Write (e);

End;

Procedure wertic;

Var i: byte;

Begin

     Write ('|','  ':n2,'||');

     For i: =1 to Nb-1 do Write ('  ':n1,'|');

     WriteLn ('  ':n1,'||', '  ‘:4,'|');

End;

Procedure Tabl;

Begin

    ClrScr;

    TextColor (1);

    H: =6+Na*3;

    L: =14+Nb*7;

    GotoXY (1, 3);

    For i: =3 to h do wertic;

    GotoXY (1, 2);

  Goriz (       );

    For i: =1 to Na+1 do begin

        GotoXY (1, i*3+2);

        If (i=1) or (i=Na+1)

         Then goriz (   )

          Else goriz (   );

End;

    GotoXY (1, h+1);

Goriz (     );

    TextColor (9);

    For i: =1 to Na do begin

        GotoXY (5, i*3+3);

        Write ('A', i);

    End;

    For i: =1 to Nb do begin

        GotoXY (i*(n1+1) + n2-2, 3);

        Write ('B', i);

    End;

    L: =Nb*(n1+1) + n2+3;

    H: =Na*3+6;

    PrintS (4, 3,'\Bj', 9);

    PrintS (4, 4, 'Ai\', 9); 

    PrintS (1, 1,'Таблица №1’, 14);

    PrintS (l, 4,'alfa', 9);

    PrintS (3, h, 'betta', 9);

End;

 

Procedure W_W (Var a: massiw; b: byte; c: char); {Ввод в таблицу}

Var i, l, m: byte;                              {кол-ва продукции}

Begin                                            {поставщиков и потребителей}

     For i: =1 to b do begin

         TextColor (3);

         GotoXY (32, 1);

         ClrEOL;

         Write(c, i, '= ‘);

         Rid (a[i], n1);

         TextColor (10);

         Case c of

'A':     GotoXY (n2-trunc (ln (a[i])/ln (10)), i*3+4);

'B':     GotoXY (n2+i*(n1+1)-trunc (ln (a[i])/ln (10)), 4);

         End;

         Write (a[i]);

     End;

End;

Function FF: integer;         {Вычисление стоимости плана}

Var i, j: byte;

    F: integer;

Begin

     F: =0;

     For i: =1 to Na do

         For j: =1 to Nb do

             If p [i, j]>0 then Inc (f, c [i, j]*p [i, j]);

     GotoXY (65, NT+2);

     TextColor (10);

     Write ('F', NT,'=', f);

     FF: =f;

End;

Function a_b: Boolean;        {Расчёт потенциалов}

Var k, i, j: byte;              {alfa и betta}

    Z_a, Z_b: massiw;

    D: Boolean;

Begin

     Nul (Z_a); Nul (Z_b);

     Alfa [1]:=0; Z_a [1]:=1; k: =1;

     Repeat

           D: =1=1;

           For i: =1 to Na do

               If Z_a[i] =1 then

                  For j: =1 to Nb do

                      If (p [i, j]>-1) and (Z_b[j] =0) then begin

                         Z_b[j]:=1;

                         Betta [j]:=c [i, j]-alfa[i];

                         Inc (k);

                         D: =1=2;

                      End;

           For i: =1 to Nb do

               If Z_b[i] =1 then

                  For j: =1 to Na do

                      If (p [j, i]>-1) and (Z_a[j] =0) then begin

                         Z_a[j]:=1;

                         Alfa[j]:=c [j, i]-betta[i];

                         Inc (k);

                         D: =1=2;

                      End;

     Until (k=Na +Nb) or d;

     If d then begin

        I: =1;

        While Z_a[i] =1 do Inc (i);

        J: =1;

        While Z_b[j] =0 do Inc (j);

        P [i, j]:=0;

        Print ((j+1)*(n1+1) +n2-8, i*3+4, 1, p [i, j], 7);

     End;

     a_b:=d;

End;

Procedure W_p;              {Вывод плана распределения}

Var i, j, h, l, k: byte;

    c_max: integer;

Begin

     K: =0;

     For i: =1 to Na do begin

         H: =i*3+4;

         For j: =1 to Nb do begin

             L: =j*(n1+1) +n2-5;

             GotoXY (l, h);

             Write (' ':n1);

             If p [i, j]>0 then begin

                Inc (k);

                Print(l-trunc(ln(p[i, j])/ln(10))+5,h,1,p[i, j],14);

             End

             Else if p [i, j] =0 then begin

                     Print (l+n1-2, h, 1, p [i, j], 14);

                     Inc (k);

             End;

         End;

     End;

 

     While a_b do Inc (k);

If k>Na+Nb-1 then PrintS (40, 1,'k > n+m-1', 12);

End;

Function KKK (Var ki, kJ: byte): integer; {Расчёт коэффициентов}

Var i, j: byte;                          {в свободных клетках}

    K, k_min: integer;

    B: Boolean;

Begin

     B: =1=1;

     For i: =1 to Na do

         For j: =1 to Nb do

             If p [i, j] =-1 then begin

                K: =c [i, j]-alfa[i]-betta[j];

                If b then begin

                   B: =1=2;

                   Ki: =i; kJ: =j; k_min: =k;

                End else

                    If k<k_min then begin

                       k_min:=k;

                       Ki: =i; kJ: =j;

                    End;

                TextColor (10);

                GotoXY (j*(n1+1) +n2-5, i*3+4);

                Write ('(', k,')');

             End;

     If k_min<0 then PrintS (kJ*(n1+1) +n2, ki*3+4,'X', 12);

     KKK: =k_min;

End;

 

Procedure div_mod(c: byte; Var a, b: byte);           {Перевод}

Begin                                                                             {одномерного массива}

     B: =c mod Nb; a: =c div Nb +1;                   {в двухмерный}

     If b=0 then begin

        B: =Nb; dec (a);

     End;

End;

Procedure Rek (Xi, Yi: byte; Var z: Boolean; Var c: byte);

Var i, j: byte;

Begin                         {Рекурсивная процедура}

   Z: =1=2;                {определяет контур перемещения}

   Case c of

1:  for i: =1 to Na do

         If i<>Xi then

            If p [i, Yi]>-1 then begin

               If u [(i-1)*Nb +Yi] =0 then begin 

                  U [(Xi-1)*Nb +Yi]: = (i-1)*Nb +Yi;

                  C: =2;

                  Rek (i, Yi, z, c);

                  If z then exit;

               End;

            End

            Else if (i =ki) and (Yi =kJ) then begin

                   U [(Xi-1)*Nb +Yi]: = (ki-1)*Nb +kJ;

                    Z: =not z;

                    Exit;

            End;

2:   for i: =1 to Nb do

         If i<>Yi then

            If p [Xi, i]>-1 then begin

               If u [(Xi-1)*Nb +i] =0 then begin

                  U [(Xi-1)*Nb +Yi]: = (Xi-1)*Nb +i;

                  C: =1;

                  Rek (Xi, i, z, c);

                  If z then exit;

               End;

            End

            Else if (Xi=ki) and (i=kJ) then begin

                    U [(Xi-1)*Nb +Yi]: = (ki-1)*Nb +kJ;

                    Z: =not z;

                    Exit;

            End;

   End;

   U [(Xi-1)*Nb +Yi]:=0;

   C: =c mod 2 +1;

<span class="dash041e_0431_044b_0447_043d_044b_0439__Char" style=" font-family: 'Courier New', 'Arial'; font-size: 10pt; text-de