Смекни!
smekni.com

Решение транспортных задач (стр. 5 из 5)

readln(a[i]);

if a[i]=0 then

begin

k:=1;

i:=i-1;

end

else

begin

a1[i]:=a[i];

s1:=s1+a1[i];

i:=i+1;

end;

end;

j:=1;

k:=0;

s2:=0;

textcolor(5);

while (k=0) and (j<m) do

begin

write('введите запрос ',j,'-того потребителя: ');

readln(b[j]);

if b[j]=0 then

begin

k:=1;

j:=j-1;

end

else

begin

b1[j]:=b[j];

s2:=s2+b1[j];

j:=j+1;

end;

end;

textcolor(yellow);

k:=0;

if s1<s2 then

begin

writeln('ошибка ввода, проверьте баланс');

readln;

halt;

end;

if (s2<s1) and (k=0) then

begin

writeln('ошибка ввода, проверьте баланс');

readln;

halt; end;

x:=i;

y:=j;

end;


ЗАКЛЮЧЕНИЕ

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

Программа реализована на языке программирования Паскаль.

Все вводимые данные и начальный базис выводятся в виде таблицы.

В программе удобный и понятный пользовательский интерфейс. Для ввода данных используется клавиатура. Данные, выводимые программой, соответствуют тем, что получены при расчетах без использования компьютера. Таким образом, поставленная задача была выполнена.


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

1 Общий курс высшей математики для экономистов. Учебник / под ред В.И. Ермакова.- М.: ИНФА – М. – 656 с. – (серия «высшее образование»).

2 Сборник задач и упражнений по высшей математике: математическое программирование: учебник пособие / А.В. Кузнецов, В.А. Сакович, Н.И. Холод и др; МН.: выш. ик., 2002. – 447с.:ил.

3 Т.Л. Партыкина, И.И. Попов Математические методы: учебник. – М.: ФОРУМ: ИНФА-М, 2005. – 464 с.: ил – (профессиональное образование)

4. И.Г. Семакин Основы программирования: учебник для сред. проф. Образования / И.Г. Семакин, А.П.Шестаков. – 2-е изд., стер,- М.: Издательский центр «Академия», 2003.-432 с.

5 Федосеев В.В. и др. Экономико-математические методы и прикладные модели: учебное пособие для ВУЗов. - М.: Юнити, 2002.

6 Коршунов Ю.М. математические основы кибернетики: учебное пособие для ВУЗов. – М.: Энергоатомиздат, 1987.


ПРИЛОЖЕНИЕ А

Листинг программы

programsev_zap;

usescrt; {подключение модуля "crt"}

const n=5; {количество строк}

m=5; {количество столбцов}

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

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

a1:array [1..n] of integer; {вспомогательный массив запасов}

b1:array [1..m] of integer; {вспомогательный массив потребностей}

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

i,j,k,x,y,s1,s2:integer;

{вводсклавиатуры}

procedure vvod_klav;

begin

i:=1;

k:=0;

s1:=0;

while (k=0) and (i<n) do

begin

write('введите запaсы ',i,'-того поставщика: ');

readln(a[i]);

if a[i]=0 then

begin

k:=1;

i:=i-1;

end

else

begin

a1[i]:=a[i];

s1:=s1+a1[i];

i:=i+1;

end;

end;

j:=1;

k:=0;

s2:=0;

textcolor(5);

while (k=0) and (j<m) do

begin

write('введите запрос ',j,'-того потребителя: ');

readln(b[j]);

if b[j]=0 then

begin

k:=1;

j:=j-1;

end

else

begin

b1[j]:=b[j];

s2:=s2+b1[j];

j:=j+1;

end;

end;

textcolor(yellow);

k:=0;

if s1<s2 then

begin

writeln('ошибка ввода, проверьте баланс');

readln;

halt;

end;

if (s2<s1) and (k=0) then

begin

writeln('ошибка ввода, проверьте баланс');

readln;

halt;

end;

x:=i;

y:=j;

end;

begin

textcolor(white);

clrscr; {очистка экрана}

writeln(‘Построение начального базиса в сбалансированной транспортной задаче методом северо-западного угла’);

writeln;

writeln(‘Программу составил: Руднев Егор Николаевич’);

writeln;

vvod_klav; {процедура ввода с клавиатуры}

repeat

k:=0;

if (b[j]-a[i]<0) then

begin

c[i,j]:=b[j];

a[i]:=a[i]-b[j];

b[j]:=0;

j:=j-1;

k:=1;

end;

if (b[j]-a[i]>0) and (k=0) then

begin

c[i,j]:=a[i];

b[j]:=b[j]-a[i];

a[i]:=0;

i:=i-1;

k:=1;

end;

if (b[j]-a[i]=0) and (k=0) then

begin

c[i,j]:=a[i];

a[i]:=0;

b[j]:=0;

i:=i-1;

j:=j-1;

end;

if (i=0) or (j=0) then break;

until false;

{вывод на экран базисного решения}

clrscr;

textcolor(white);

for i:=1 to x do

begin

for j:=1 to y do

if j=y then write(c[i,j]:6,' │ ',a1[i])

else

write(c[i,j]:6);

writeln;

end;

write(' ');

for i:=1 to y*6-4 do

write(#196);

writeln('┘');

for j:=1 to y do

write(b1[j]:6);

readln;

end.