Студопедия КАТЕГОРИИ: АвтоАвтоматизацияАрхитектураАстрономияАудитБиологияБухгалтерияВоенное делоГенетикаГеографияГеологияГосударствоДомЖурналистика и СМИИзобретательствоИностранные языкиИнформатикаИскусствоИсторияКомпьютерыКулинарияКультураЛексикологияЛитератураЛогикаМаркетингМатематикаМашиностроениеМедицинаМенеджментМеталлы и СваркаМеханикаМузыкаНаселениеОбразованиеОхрана безопасности жизниОхрана ТрудаПедагогикаПолитикаПравоПриборостроениеПрограммированиеПроизводствоПромышленностьПсихологияРадиоРегилияСвязьСоциологияСпортСтандартизацияСтроительствоТехнологииТорговляТуризмФизикаФизиологияФилософияФинансыХимияХозяйствоЦеннообразованиеЧерчениеЭкологияЭконометрикаЭкономикаЭлектроникаЮриспунденкция |
Лабораторная работа №3. Решение транспортной задачи1. Нахождение опорного плана методом северо-западного угла или минимального элемента. 2. Нахождение оптимального решения методом потенциалов.
Входные данные: - Метод нахождения опорного плана(1-северо-западного угла,2-минимального элемента); - Выбор ввода (y -из файла;n- формируется таблица с клавиатуры); - M - количество пунктов отправления; - N- количество пунктов потребления; - Ai –запасы в i-ом пункте ; - Bj-потребность j-го пункта; - Ci j-элементы матрицы стоимостей перевозок единицы продукции.
Выходные данные:
– Таблицы с циклами пересчета; – Таблица оптимального плана грузоперевозок; – f-минимальная стоимость перевозок Пример.
A1=140 B1=60 2 3 4 2 4 A2=180 B2=70 C = 8 5 1 4 1 A3=160 B3=120 9 8 4 7 2 B4=130 B5=100
Текст программы.
{This is Transport Task for Open and close task together} Uses Crt; Label l1; Const N=8; n1=7; n2=7; Sa:longint=0; Sb:longint=0; AColor=cyan; BColor=cyan; CColor=LightRed; UColor=LightGreen; VColor=LightGreen; PColor=yellow; Allcolor=White; TableColor=White; TableTextColor=White; ErrColor=LightRed; backGround=1; Type predpr=Array [1..N] of longint; rasp=Array [1..N,1..N] of longint; Var A,B,U_potenc,V_potenc,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; method:byte; Procedure ZeroArray (var a:predpr); var i:byte; Begin for i:=1 to N do a[i]:=0; End;
Procedure WriteXYC (x,y:byte; s:string; c:byte); Begin TextColor(c); GotoXY(x,y); Write(s); End; Procedure WriteXYF (x,y:byte; n:byte; a:longint; c:byte); Begin TextColor(c); GotoXY(x,y); Write(' ':n); GotoXY(x,y); Write(a); End; Procedure InputVar (var x:longint; y:byte); var i:integer;  s:string; c:char; j,k:byte; Begin s:=''; i:=1; TextColor(AllCOlor); 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(ErrColor); Write('ЌҐ Ў®«ҐҐ '); for k:=1 to y-1 do Write('9'); TextColor(AllCOlor); end; GotoXY(j,1); Until (ord(c)=13) and (i<y+1); val(s,x,i); End; Procedure HorizLine (a,b,c,d,e:char); var i,j:byte; 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 VertLine; var i:byte; Begin Write('і',' ':n2,'і'); for i:=1 to Nb-1 do Write(' ':n1,'і'); WriteLn(' ':n1,'і',' ' :4,'і'); End; procedure ClearWind(x1,y1,x2,y2:byte); var i,j:byte; begin for i:=x1 to x2 do for j:=y1 to y2 do begin gotoxy(i,j); Write(#32); end; end; Procedure DrawTable; Begin { ClrScr;} ClearWind(1,1,Lo(windmax),na*5); TextColor(TableCOlor); h:=6+Na*3; l:=14+Nb*7; GotoXY(1,3); for i:=3 to h do VertLine; GotoXY(1,2); HorizLine('+','Д','+','+','+'); for i:=1 to Na+1 do begin GotoXY(1,i*3+2); if (i=1) or (i=Na+1) then HorizLine('+','Н','+','+','+') else HorizLine('+','Д','+','+','+'); end; GotoXY(1,h+1); HorizLine('+','Д','+','+','+'); TextColor(TableTextColor); 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; WriteXYC(4,3,'B-->',TableTextColor); WriteXYC(4,4,'A',TableTextColor); { WriteXYC(1,1,'’ Ў«Ёж N1',AllColor);} WriteXYC(l,4,' U',TableTextColor); WriteXYC(3,h,' V',TableTextColor); End; Procedure InputC (var a:predpr; b:byte; c:char); var i,l,m:byte; Begin for i:=1 to b do begin TextColor(AllColor); GotoXY(32,1); ClrEOL; Write(c,i,'= '); InputVar(a[i],n1); TextColor(CColor); 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 PricePlan: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(2,Hi(windMax)-2); ClrEOL; TextColor(PColor); Write('Func = ',f); PricePlan:=f; End;
Function CalcPotenc:boolean; var k,i,j:byte; {U_potenc Ё V_potenc} Z_a,Z_b:predpr; d:boolean; Begin ZeroArray(Z_a); ZeroArray(Z_b); U_potenc[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; V_potenc[j]:=c[i,j]-U_potenc[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; U_potenc[j]:=c[j,i]-V_potenc[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; WriteXYF((j+1)*(n1+1)+n2-8,i*3+4,1,p[i,j],7); end; for i:=1 to n1 do U_Potenc[i]:=-U_Potenc[i]; CalcPotenc:=d; End; Procedure OutPlan; 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); WriteXYF(l-trunc(ln(p[i,j])/ln(10))+5,h,1,p[i,j],14); end else if p[i,j]=0 then begin WriteXYF(l+n1-2,h,1,p[i,j],14); inc(k); end; end; end; While CalcPotenc do inc(k); if k>Na+Nb-1 then WriteXYC(40,1,'k > n+m-1',ErrColor); End; Function CalcPotecTable(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]+U_potenc[i]-V_potenc[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(ErrColor); GotoXY(j*(n1+1)+n2-5,i*3+4); Write('(',k,')'); end; if k_min<0 then WriteXYC(kj*(n1+1)+n2,ki*3+4,'X',ErrColor); CalcPotecTable:=k_min; End; Procedure Array1Dto2D(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 CalcContur(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; CalcContur(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; CalcContur(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 OutContur; 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; CalcContur(ki,kj,z,l); i:=ki; j:=kj; k:=u[(i-1)*Nb+j]; Array1Dto2D(k,i,j); mi:=i; mj:=j; l:=1; Repeat inc(l); k:=u[(i-1)*Nb+j]; Array1Dto2D(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); WriteXYC((n1+1)*j+n2-1,i*3+3,'(+)',Errcolor); end else begin dec(p[i,j],p_m); WriteXYC((n1+1)*j+n2-1,i*3+3,'(-)',errcolor); end; if l=0 then inc(p[i,j]); k:=u[(i-1)*Nb+j]; Array1Dto2D(k,i,j); inc(l); Until (i=ki) and (j=kj); p[mi,mj]:=-1; End; Procedure PressAnyKey; var d:char; Begin TextColor(AllCOlor); GotoXY(40,1); Write(' (SPACE)'); while ReadKey<>#32 do; GotoXY(40,1); ClrEOL; End; var ft:text;bt:boolean;cp:char; BEGIN TextBackGround(background); ClrScr; ZeroArray(U_potenc); ZeroArray(V_potenc); Nt:=1; TextColor(AllColor); method:=0; repeat write(''); readln(Na); if (na<>1)and(na<>2) then method:=0 else method:=na; until method<>0; repeat write(' [Y/N]: '); readln(cp); until (UpCase(cp)='Y')or(UpCase(cp)='N'); if UpCase(cp)='Y' then bt:=true else bt:=false; if not bt then begin{bt} Repeat Write('‚ ',N-1,': '); ReadLn(Na); Write('‚ ',N-1,' '); ReadLn(Nb); Until (Na>1) and (Na<=N-1) and (Nb>1) and (Nb<=N-1);
if na>5 then TextMode(C80 + Font8x8);
TextBackGround(background); ClrScr; DrawTable; WriteXYC(1,1,'‚,AllColor); InputC(A,Na,'A'); InputC(B,Nb,'B'); TextColor(AllColor); GotoXY(1,1); ClrEOL; Write('‚); for i:=1 to Na do for j:=1 to Nb do begin TextColor(AllCOlor); GotoXY(29,1); ClrEOL; Write('A',i,' - B',j,' '); InputVar(c[i,j],5); WriteXYF((n1+1)*j+n2-4,i*3+3,1,c[i,j],11); end; END{BT} else begin{prev} assign(ft,'prev.dat'); {$I-} reset(ft); {$I+} if IOResult<>0 then begin writeln('Error to open file prev.dat'); exit; end; readln(ft,na,nb); for i:=1 to na do read(ft,a[i]); readln(ft); for i:=1 to nb do begin read(ft,b[i]); end; readln(ft); if na>5 then TextMode(C80 + Font8x8); TextBackGround(background); ClrScr; DrawTable; for i:=1 to na do begin for j:=1 to nb do begin read(ft,c[i,j]); TextColor(AllCOlor); WriteXYF((n1+1)*j+n2-4,i*3+3,1,c[i,j],11); end; readln(ft); end; close(ft); end; (**********************************************************) GotoXY(1,1); ClrEOL; TextColor(AllCOlor); { 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 WriteXYC(20,1,',AllColor); d:=ReadKey; if Sa>Sb then begin inc(Nb); B[Nb]:=Sa-Sb; WriteXYC(1,Hi(windMax)-1,'„,AllCOlor); 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; WriteXYC(1,Hi(windMax)-1,'„',AllColor); end; DrawTable; for i:=1 to Na do for j:=1 to Nb do WriteXYF((n1+1)*j+n2-4,i*3+3,1,c[i,j],11); for i:=1 to Na do WriteXYF(n2-trunc(ln(A[i])/ln(10)),i*3+4,1,A[i],14); for i:=1 to Nb do WriteXYF(n2+i*(n1+1)-trunc(ln(B[i])/ln(10)),4,1,B[i],14); WriteXYC(20,1,',AllColor); end else WriteXYC(20,1, ',AllColor); assign(ft,'prev.dat'); rewrite(ft); writeln(ft,na,' ',nb); for i:=1 to na do write(ft,a[i],' '); writeln(ft); for i:=1 to nb do write(ft,b[i],' '); writeln(ft); for i:=1 to na do begin for j:=1 to nb do write(ft,c[i,j],' '); writeln(ft); end; close(ft); case method of 2:{Min element}BEGIN 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; END; 1:{Noth-West element}BEGIN 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; 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; END; end;{case method} (***********************************************************) for i:=1 to Na do for j:=1 to Nb do if p[i,j]=0 then p[i,j]:=-1; OutPlan; f:=PricePlan; f0:=F; While CalcPotenc do; for i:=1 to Na do WriteXYF(l+1,i*3+3,3,U_potenc[i],11); for i:=1 to Nb do WriteXYF(i*(n1+1)+n2-4,h,6,V_potenc[i],11); PressAnyKey;
While CalcPotecTable(ki,kj)<0 do begin OutContur; PressAnyKey; for i:=1 to Na do for j:=1 to Nb do WriteXYC((n1+1)*j+n2-1,i*3+3,' ',AllColor); inc(Nt); GotoXY(1,1); { Write('’ Ў«Ёж N',Nt);} OutPlan; f0:=f; f:=PricePlan; if CalcPotenc then Goto l1; for i:=1 to Na do WriteXYF(l+1,i*3+3,3,U_potenc[i],11); for i:=1 to Nb do WriteXYF(i*(n1+1)+n2-4,h,6,V_potenc[i],11); PressAnyKey; end; (***********************************************************) WriteXYC(40,1,,ErrColor); WriteXYC(60,1,',AllCOlor); 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; TextMode(lastmode); END. Входные данные:
Введите метод ( 1−метод северо-западного угла ; 2−метод минимального элемента) 1 Введите запасы A1 −A3 Введите потребности B1 –B5 Введите матрицу стоимости перевозок С из Ai в Bj Формируется таблица входных данных.
Результат выполнения программы.
Варианты заданий.
|
|||||||||||||||||||||||||||||||||||
|
|
Последнее изменение этой страницы: 2018-04-12; просмотров: 215. stydopedya.ru не претендует на авторское право материалов, которые вылажены, но предоставляет бесплатный доступ к ним. В случае нарушения авторского права или персональных данных напишите сюда... |
1) а1 =200 b2 = 130
а2 =175 b3 = 80 
5 7 4 2 5
а3 =225 b4 = 190 
10) а1 =200 b2 = 130
а2 =350 b3 = 190 24 50 55 27 16
а3 =300 b4 = 150 
19) а1 =270 b2 = 210
а2 =450 b3 = 200 37 30 15 19 37
а3 =330 b4 = 230 
28) а1 =270 b2 = 210
а2 =450 b3 = 200 7 3 10 1 3
а3 =330 b4 = 230