Постановка задачи. Имеется m пунктов отправления А1, А2 , , Аm , в которых сосредоточены запасы каких-то однородных грузов в количестве соответственно а1Имеется m пунктов отправления А1, А2,..., Аm, в которых сосредоточены запасы каких-то однородных грузов в количестве соответственно а1, а2,..., аm единиц. Имеется n пунктов назначения В1, В2,..., Вn подавшие заявки соответственно на b1, b2,..., bn единиц груза. Известны стоимости Сi, j перевозки единицы груза от каждого пункта отправления Аi до каждого пункта назначения Вj. Все числа Сi, j, образующие прямоугольную таблицу заданы. Требуется составить такой план перевозок (откуда, куда и сколько единиц поставить), чтобы все заявки были выполнены, а общая стоимость всех перевозок была минимальна.
Составить программу, которая бы вычисляла оптимальный план перевозки (потенциальный план). Программа на языке Pascal: Program transportnaj_zadatsha; Uses Crt; Label l1; Const N=6; n1=7; n2=7; Sa: longint=0; Sb: longint=0; Type predpr=Array [1..N] of longint; rasp=Array [1..N, 1..N] of longint; Var A, B, alfa, betta, B_d, x: predpr; c, p: rasp; f, f0, x_min, Sp: longint; Nt, x_p, r, r_min, ki, kj, Na, Nb, h, l, i, j: byte; d: char; u: Array[1..N*N] of byte;
Procedure Nul (var a: predpr); {обнуляет массив} 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: longint; c: byte); Begin {вывод числа a} TextColor(c); GotoXY(x, y); Write(' ': n); GotoXY(x, y); Write(a); End;
Procedure Rid (var x: longint; 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, 'Таблица N1', 14); PrintS(l, 4, 'alfa', 9); PrintS(3, h, 'betta', 9); End;
Procedure W_W (var a: predpr; 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(14); 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: longint; {Вычисление стоимости плана} var i, j: byte; f: longint; 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: predpr; 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: longint; 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; {Расчет коэф. k} 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(6); 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; End;
Procedure kontur; {Определяет контур перемещения} var i, j, k, mi, mj, l: byte; z: boolean; p_m: longint; Begin for i: =1 to N*N do u[i]: =0; l: =1; Rek(ki, kj, z, l); i: =ki; j: =kj; k: =u[(i-1)*Nb+j]; div_mod(k, i, j); mi: =i; mj: =j; l: =1; Repeat inc(l); k: =u[(i-1)*Nb+j]; div_mod(k, i, j); if l mod 2=1 then if p[i, j]< p[mi, mj] then begin mi: =i; mj: =j; end; Until (i=ki) and (j=kj);
i: =ki; j: =kj; l: =0; p_m: =p[mi, mj]; Repeat if l mod 2=0 then begin inc(p[i, j], p_m); PrintS((n1+1)*j+n2-1, i*3+3, '(+)', 12); end else begin dec(p[i, j], p_m); PrintS((n1+1)*j+n2-1, i*3+3, '(-)', 12); end; if l=0 then inc(p[i, j]); k: =u[(i-1)*Nb+j]; div_mod(k, i, j); inc(l); Until (i=ki) and (j=kj); p[mi, mj]: =-1; End;
Procedure Pauza; var d: char; Begin TextColor(6); GotoXY(40, 1); Write('Нажмите любую клавишу'); d: =ReadKey; GotoXY(40, 1); ClrEOL; End;
BEGIN Nul(alfa); Nul(betta); Nt: =1; ClrScr; TextColor(10); Repeat Write('Введите количество поставщиков (2< =Na< =', N-1, ') '); ReadLn(Na); Write('Введите количество потребителей (2< =Nb< =', N-1, ') '); ReadLn(Nb); Until (Na> 1) and (Na< =N-1) and (Nb> 1) and (Nb< =N-1); Tabl;
(******************* ввод начальных данных ******************) PrintS(1, 1, 'Введите количество продукции: ', 3); W_W(A, Na, 'A'); W_W(B, Nb, 'B'); TextColor(3); GotoXY(1, 1); ClrEOL; Write('Введите стоимость перевозки'); for i: =1 to Na do for j: =1 to Nb do begin TextColor(3); GotoXY(29, 1); ClrEOL; Write('A', i, ' - B', j, ' '); Rid(c[i, j], 5); Print((n1+1)*j+n2-4, i*3+3, 1, c[i, j], 11); end; (**********************************************************)
GotoXY(1, 1); ClrEOL; TextColor(14); Write('Таблица N1');
for i: =1 to Na do Sa: =Sa+A[i]; for i: =1 to Nb do Sb: =Sb+B[i]; if Sa< > Sb then begin {если задача является открытой} PrintS(20, 1, 'Открытая задача (Нажмите любую клавишу)', 7); d: =ReadKey; if Sa> Sb then begin inc(Nb); B[Nb]: =Sa-Sb; for i: =1 to Na do c[i, Nb]: =0; end else begin inc(Na); A[Na]: =Sb-Sa; for i: =1 to Nb do c[Na, i]: =0; end; Tabl; for i: =1 to Na do for j: =1 to Nb do Print((n1+1)*j+n2-4, i*3+3, 1, c[i, j], 11); for i: =1 to Na do Print(n2-trunc(ln(A[i])/ln(10)), i*3+4, 1, A[i], 14); for i: =1 to Nb do Print(n2+i*(n1+1)-trunc(ln(B[i])/ln(10)), 4, 1, B[i], 14); PrintS(20, 1, 'Открытая задача', 7); end else PrintS(20, 1, 'Закрытая задача', 7);
(************** cоставление опорного плана ****************) for i: =1 to Nb do B_d[i]: =B[i]; for i: =1 to Na do begin for j: =1 to Nb do x[j]: =j; for j: =1 to Nb-1 do begin x_min: =c[i, x[j]]; r_min: =j; for r: = j+1 to Nb do if (x_min> c[i, x[r]]) or ((x_min=c[i, x[r]]) and (B[x[r]]> b[x[r_min]])) then begin x_min: =c[i, x[r]]; r_min: =r; end; x_p: =x[r_min]; x[r_min]: =x[j]; x[j]: =x_p; end; Sp: =0; for j: =1 to Nb do begin p[i, x[j]]: =B_d[x[j]]; if p[i, x[j]]> A[i]-Sp then p[i, x[j]]: =A[i]-Sp; inc(Sp, p[i, x[j]]); dec(B_d[x[j]], p[i, x[j]]); end; end; (***********************************************************)
for i: =1 to Na do for j: =1 to Nb do if p[i, j]=0 then p[i, j]: =-1; W_p; f: =FF; f0: =F;
While a_b do; for i: =1 to Na do Print(l+1, i*3+3, 3, alfa[i], 14); for i: =1 to Nb do Print(i*(n1+1)+n2-4, h, 6, betta[i], 14); Pauza; (******* постепенное приближение плана к оптимальному ******) While kkk(ki, kj)< 0 do begin kontur; pauza; for i: =1 to Na do for j: =1 to Nb do PrintS((n1+1)*j+n2-1, i*3+3, ' ', 14); inc(Nt); GotoXY(1, 1); Write('Таблица N', Nt); W_p; f0: =f; f: =FF; if a_b then Goto l1; for i: =1 to Na do Print(l+1, i*3+3, 3, alfa[i], 14); for i: =1 to Nb do Print(i*(n1+1)+n2-4, h, 6, betta[i], 14); Pauza; end; (***********************************************************)
PrintS(40, 1, 'Решение оптимально', 12); PrintS(60, 1, '(any key)', 6); for i: =1 to Na do for j: =1 to Nb do if p[i, j]=-1 then begin h: =i*3+4; l: =j*(n1+1)+n2-5; GotoXY(l, h); Write(' ': n1); end; GotoXY(40, 1); l1: d: =ReadKey; END.
Список литературы 1 Сборник задач и упражнений по высшей математике: Математическое программирование: Учеб. пособие/А. В. Кузнецов, Сакович В.А, Н.И. Холод и др.; Под общ. ред. А. В. Кузнецова, Р.А. Рутковского. — 2-е изд. - Мн.: Выш. шк., 2002. — 447 с.: ил. 2 Руководство к решению задач по математическому программированию: Учеб. пособие/ А.В. Кузнецов, Н.И. Холод, Л.С. Костевич; Под общ. ред. А.В.Кузнецова. – 2-е изд. – Мн.: Выш. шк., 2001. – 448 с.: ил. 3 Высшая математика: Мат. программир.: Учеб. / А.В. Кузнецов, В.А. Сакович, Н.И. Холод; Под общ. ред. А.В.Кузнецова. – Мн.: Выш. шк., 1994. – 286 с.: ил. 4 Программирование в алгоритмах / С.М.Окулов. – 2-е изд. – М.: БИНОМ. Лаборатория знаний, 2006. – 283 с.: ил. 5 Экономико-математические методы и модели: Учеб. пособие /Н. И. Холод, А. В. Кузнецов, Я. Н. Жихар и др.; Под общ. ред. А.В Кузнецова. 2-е изд. – Мн.: БГЭУ, 2000. – 412 с. 6 Костевич Л.С. Математическое программирование: Информ. технологии оптимальных решений: Учеб. пособие /Л.С. Костевич. – Мн.: Новое знание, 2003. – 424 с.: ил. 7 Кудрявцев Е.М. Исследование операций в задачах, алгоритмах, программах. – М.: Радио и связь, 1984. – 184 с., ил. 8 Волков И.К., Загоруйко Е.А. Исследование операций: Учеб. для вузов. 2-е изд. /Под ред. В.С. Зарубина, А.П.Крищенко. – М.: Изд-во МГТУ им. Н.Э. Баумана, 2002. – 436 с. 9 Самарский А.А., Михайлов А.П. Математическое моделирование. Идеи. Методы. Примеры. - М.: Наука, 1997. 10 Методическое пособие, “Экстремальные задачи теории графов”.-Мн.: БГУ, 2000.
|
