program diplom; {$M 16384,0,655360} uses Objects, Drivers, Views,validate, app, Menus, Dialogs, Memory, Crt, Strings, MSGBox; const max_var = 15; max_bls = 5; hcNoCon =0; cmAbout =102; cmZad =126; HelpOpen : Boolean = false; type PMy = ^TMy; TMy =object(TApplication) procedure zad; procedure NewDialog; procedure InitStatusLine; virtual; procedure InitMenuBar; virtual; procedure HandleEvent( var Event: TEvent); virtual; procedure DoHelp( name : string ); end; var ccc, cc : word; aqw : PChar; Dialog : PDialog; RR : TRect; myapp : TMy; ug_t_ : array [1..max_var, 1..max_var, 1..max_var] of real; nom_ : array [1..max_var, 1..max_var] of byte; znak : array [1 ..max_var] of string[2]; ch_, ch_ur_, cv_ug_, nach_ : array[1..max_var] of byte; end_ : array[0..max_var] of byte; fl :boolean; b :array[1..max_var] of real; a :array[1 ..max_var, 1 ..max_var] of real; c :array[1 ..2,1..max_var] of real; e :array[1..max_var] of byte; p_1,p_2,p_sigma_1 ,p_sigma_2 :array[1 ..max_var] of real; a_ss,ug_t_1 ,ug_t_2,a_bs,aa,p_l :array[1 ..max_var, 1 ..max_var] of real; nom_1 ,nom_2 :array[1..max_var] of byte; b_new,p_delta_1 ,p_delta_2 :array[1 ..max_var] of real; dop_stolb,tmp_1 ,tmp_2,sigma :array[1 ..max_var] of real; lymbda :array[1 ..2] of real; lymbda_0,skobka_1 ,skobka_2,prom_1 ,prom_2,sigma_l :array[1..max_var] of real; i,j,k,m,n,n1,r,w,u,u1,ku,m1 :byte; ch_1 ,ch_2 ,cv_ug_1 ,cv_ug_2 :byte; n_t_1 ,n_t_2 ,ss :byte; min, t, z, q, l, h, v, min_1, min_2 :real; sigma_1, sigma_2, sigma_r, minimum :real; metka, labl, s :byte; z_max :real; nv, nw, nvw :string; procedure TMy.Zad; label 1; {$l danz_v2.pas } procedure p_sigma( n_t_l ,n_t_2:byte); var i,j :byte; begin sigma_1 := 0; sigma_2 := 0; for i:=1 to n1 do begin p_1[i]:=0; p_2[i]:=0; end; for i:=1 to ch_1 do sigma_1 := sigma_1 + c[1,nom_1[i]] * ug_t_1[n_t_1,i]; for i:=1 to ch_2 do sigma_2 := sigma_2 + c[1,nom_2[i]] * ug_t_2[n_t_2,i]; for j:=1 to n1 do for i:=1 to ch_1 do p_1[j]:= p_1[j] + a_bs[j,nom_1[i]] * ug_t_1[n_t_1,i]; for j:=1 to n1 do for i:=1 to ch_2 do p_2[j] := p_2[j] + a_bs[j,nom_2[i]] * ug_t_2[n_t_2,i]; end; procedure m_sim( metka :byte ); var i,j,k :byte; nomer_str :byte; raz_el :real; begin if metka = 1 then begin if labl = 1 then begin for i:=1 to n1+2 do dop_stolb[i]:=p_delta_1 [i]; sigma_r:=sigma_1; end else begin for i:=1 to n1+2 do dop_stolb[i]:=p_delta_2[i]; sigma_r:=sigma_2; end; for i := 1 to n1+2 do if dop_stolb[i] > 0 then begin raz_el := b_new[i]/dop_stolb[i]; nomer_str := i; end; for i:=1 to n1+2 do if dop_stolb[i] > 0 then if b_new[i]/dop_stolb[i] < raz_el then begin raz_el := b_new[i]/dop_stolb[i]; nomer_str := i; end; for j:=1 to n1+2do aa[nomer_str,j] := aa[nomer_str,j]/dop_stolb[nomer_str]; b_new[nomer_str] := b_new[nomer_str]/dop_stolb[nomer_str]; dop_stolb[nomer_str] := dop_stolb[nomer_str]/dop_stolb[nomer_str]; for i:=1 to n1+2 do begin if i<>nomer_str then begin for j:=1 to n1+2 do aa[i,j] := aa[i,j]-aa[nomer_str,j]*dop_stolb[i]; b_new[i] := b_new[i]-b_new[nomer_str]*dop_stolb[i]; end; end; for i := 1 to n1+2 do if i = nomer_str then sigma[i] := sigma_r end; for i := 1 to n1 do lymbda_0[i] := 0; lymbda[1] := 0; lymbda[2] := 0; for k:=1 to n1 do for j:=1 to n1+2 do lymbda_0[k] := lymbda_0[k] + sigma[j]*aa[j,k]; for k:=1 to 2 do for j:=1 to n1+2 do lymbda[k] := lymbda[k] + sigma[j]*aa[j,n1+k]; end; {-------------------------------------------} begin {ug_t;} if ccc = 1 then begin ch_1 := ch_[1]; ch_2 := ch_[2]; cv_ug_1 := cv_ug_[1]; cv_ug_2 := cv_ug_[2]; for i := 1 to ch_1 do nom_1[i] := nom_[1,i]; for i := 1 to ch_2 do nom_2[i] := nom_[2,i]; for i := 1 to cv_ug_1 do for j := 1 to ch_1 do for i := 1 to cv_ug_2 do for j := 1 to ch_2 do ug_t_2[i ,j] := ug_t_[2,i,j]; {nachalo algoritma} for i:=1 to n1 do b_new[i] := b[i]; b_new[n1 + 1] := 1; b_new[n1+2] := 1; sigma_1 := 0; sigma_2 := 0; for i:=1 to n1 do begin p_1[i]:=0; p_2[i]:=0; end; for i := 1 to u do for j := 1 to n1 + 2 do if i=j then p_l[i,j] := 1 else p_l[i,j] := 0; for i:=1 to u do if i = u1 then p_sigma_1[i]:= -1000 else p_sigma_1[i] := 0; for i:=1 to n1+2 do for j := 1 to n1 do aa[i,j] := p_l[i,j]; n_t_1 :=1; n_t_2:= 1; metka := 0; p_sigma( n_t_1 ,n_t_2 ); for i := 1 to n1 do sigma[i] := sigma_l[i]; sigma[n1 + 1] := sigma_1; sigma[n1+2] := sigma_2; for i:=1 to n1 do begin p_delta_2[i] := p_2[i] end; p_delta_1[n1 + 1]:= 1; p_delta_1[n1+2] := 0; p_delta_2[n1 + 1]:=0; p_delta_2[n1+2] := 1; for i:=1 to n1+2 do begin aa[i,n1 + 1] := p_delta_1[i]; aa[i,n1+2] := p_delta_2[i]; end; ss := 0; inc(ss); if metka <> 0 then begin p_sigma( n_t_1 ,n_t_2); for i:=1 to n1 do begin p_delta_1[i] := p_1[i]; p_delta_2[i] := p_2[i]; end; p_delta_1[n1 + 1] := 1; p_delta_1[n1+2] := 0; p_delta_2[n1 + 1]:=0; p_delta_2[n1+2] := 1; for i := 1 to n1+2 do begin tmp_1[i] :=0; tmp_2[i] := 0; for j := 1 to n1+2 do begin tmp_1[i] := tmp_1[i] + aa[i,j] * p_delta_1[j]; tmp_2[i] := tmp_2[i] + aa[i,j] * p_delta_2[j]; end; end; for i := 1 to n1+2 do begin p_delta_1[i] := tmp_1[i]; p_delta_2[i] := tmp_2[i]; end; end; m_sim(metka); {первая подзадача} for i := 1 to ch_1 do skobka_1[i] := 0; for i := 1 to ch_1 do begin for j := 1 to n1 do skobka_1[i] := skobka_1[i] + lymbda_0[j]*a_bs[j,nom_1[i]]; skobka_1[i] := skobka_1[i] - c[1,nom_1[i]]; end; for i := 1 to cv_ug_1 do begin prom_1[i] := 0; for j := 1 to ch_1 do prom_1[i] := prom_1[i] + skobka_1[j]*ug_t_1[i,j]; end; min_1:= prom_1[1]; n_t_1 := 1; for i := 2 to cv_ug_1 do if min_1 > prom_1[i] then begin min_1 := prom_1[i]; n_t_1 := i; end; {вторая подзадача} for i := 1 to ch_2 do skobka_2[i] := 0; for i := 1 to ch_2 do begin for j := 1 to n1 do skobka_2[i] := skobka_2[i] + lymbda_0[j]*a_bs[j,nom_2[i]]; skobka_2[i] := skobka_2[i] - c[1 ,nom_2[i]]; end; for i := 1 to cv_ug_2 do begin prom_2[i] := 0; for j := 1 to ch_2 do prom_2[i] := prom_2[i] + skobka_2[j]*ug_t_2[i, j]; end; min_2 := prom_2[i]; n_t_2 := 1; for i := 2 to cv_ug_2 do if min_2 > prom_2[i] then begin min_2 := prom_2[i]; n_t_2 := i; end; if min_1 + lymbda[1] < min_2 + lymbda[2] then begin minimum := min_1 + lymbda[1]; labl := 1; end else begin minimum := min_2 + lymbda[2]; labl := 2; end; if minimum >= 0 then begin z_max := 0; for i := 1 to ch_1 do z_max := z_max + ug_t_1[n_t_1,i]*c[1 ,nom_1[i]]; for i := 1 to ch_2 do z_max := z_max + ug_t_2[n_t_2,i]*c[1 ,nom_2[i]]; { gotoxy( 1, wherey + 3 ); writeln('Oптимaльный план'); write('X=('); for i := 1 to ch_l do write(ug_t_l [n_t_l ,i]: 1:3,','); for i := 1 to ch_2 do write(ug_t_2[n_t_2,i]: 1:3,','); gotoxy(wherex-l,wherey); writeln(')'); writeln('Zmax = ',z_max:l:3,'; Число итераций ',ss);} gotoxy( 1, wherey + 3 ); writeln('Оптимальный план: '); nv := 'X=('; for i := 1 to ch_1 do begin str( ug_t_1[n_t_1,i]:1:3, nv); nv := nv + nw + ','; end; for i := 1 to ch_2 do begin str( ug_t_2[n_t_2,i]:1:3, nw); nv := nv + nw + ','; end; nv := copy( nv, 1, length( nv) - 1 ) + ')'; nw := 'Zmax = '; str( z_max:1 :3, nvw ); nw := nw + nvw + '; Число итераций '; str( ss, nvw ); nw := nw + nvw; RR.Assign(3, 7, 77,18); Dialog := New( PDialog, Init( RR, 'Результаты:')); with Dialog^ do begin RR.Assign( 15, 2, 65, 3 ); {Insert( New( PLabel, Init( RR, nv, aqw))); } RR.Assign(15, 4, 65, 5); { Insert( New( PLabel, Init( RR, nw, aqw))); } RR.Assign( 5, 7, 20, 9 ); Insert( New( PButton, Init( RR,'Ok', cmOk, bfNormal))); SelectNext( false ); end; CC := DeskTop^.ExecView( Dialog ); Dispose( Dialog, Done); end; {else begin metka := 1; goto 1; end;} end; end; procedure TMy.InitMenuBar; var R : TRect; begin GetExtent( R ); R.B.Y:=R.A.Y+1; MenuBar := New( PMenuBar, Init( R, NewMenu( NewSubMenu ('~Ё~ ', hcNoCon, NewMenu( NewItem( '~O~ программе' ,'Alt О', kbaltO, cmAbout, hcNoCon, nil)), NewSubMenu(' Работа', hcNoCon, NewMenu( NewItem(' ~3~адача ', 'Alt Z', kbaltZ, cmZad, hcNoCon, NewItem(' ~В~ыход', 'Alt X', kbaltX, cmQuit, hcNoCon, nil ))), nil ))))) ; end; procedure TMy.InitStatusLine; var R : TRect; begin GetExtent( R ); R.A.Y:=R.B.Y- 1; StatusLine := New( PStatusLine, Init( R, NewStatusDef( 0, $FFFF, NewStatusKey( '~F1~ Помощь', kbF1, cmhelp, NewStatusKey( '~F10~ Меню', kbF10, cmMenu, NewStatusKey( '~Alt-X~ Выход', kbAltX, cmQuit, NewStatusKey('', kbEsc, cmClose, nil)))), nil))); end; procedure TMy.HandleEvent; var i: word; begin TApplication.HandleEvent( Event); case Event.Command of cmHelp : if not HelpOpen then begin clearEvent( Event); DoHelp( 'zad.hlp'); end; cmAbout: NewDialog; cmZad : Zad; end; end; procedure TMy.NewDialog; const txt: array[0..3] of string[35] = ( 'Решение задачи', 'линейного программирования', 'методом декомпозиции', '(Данцига-Вульфа).'); var Bruce : PView; Dialog : PDialog; R : TRect; C,P : Word; begin R.Assign( 20, 5, 58, 17); Dialog := New( PDialog, Init( R, 'О программе')); with Dialog^ do begin for P := 0 to 3 do begin R.Assign( 1, 3 + p, 35,4 + p ); Insert( New( PStaticText, Init( R, #3+txt[p]) ) ); end; R.Assign( 13,9,23, 11 ); Insert( New( PButton, Init( R, '~O~k', cmOK,bfDefault))); end; C:= DeskTop^ .ExecView( Dialog ); Dispose( Dialog, Done); end; procedure Read_Znak; label 1; const spisok : array[1..3] of string[2] = ('= =', '<=', '>='); var ch : char; j,y: byte; begin y:=1; textbackground( 3 ); textcolor( 4 ); for j := 1 to 4 do begin gotoxy( 60+j, 1 ); write( '-'); gotoxy( 60+j, 5 ); write('-'); end; for j := 1 to 3 do begin gotoxy(60, 1+j); write('│'); gotoxy( 65, 1+j ); write('│'); end; gotoxy(60,1); write('+'); gotoxy(60,5); write('+'); gotoxy(65,1); write('+'); gotoxy(65,5); write('+'); 1:for j := 1 to 3 do begin if j = y then begin textbackground(1); textcolor(14 ); end else begin textbackground(3); textcolor(4); end; gotoxy( 61, j+1 ); write('', spisok[j],'' ); end; ch := readkey; case ch of #13 : begin znak[i] := spisok[y]; exit end; #27 : begin znak[i] := ' '; exit end; end; if ch = #0 then ch :=readkey; case ch of #72 : if y > 1 then dec( y ) else y := 3; #80 : if y < 3 then inc(y) else y := 1; end; goto 1; end; { procedure TMy.Ug_T_;} const txt: array[1..2] of string [55] =( 'Задайте число переменных:', 'Задайте число ограничений:'); procedure find_ug_t( num : integer ); var i,j,k,l,ll : integer; ug_t : array [1 ..max_var] of real; function yes_ : boolean; var i,j : integer; sum : real; fl : boolean; begin yes_ := true; for i := nach_[num] to end_[num] do begin sum := 0; for j := 1 to ch_[num] do sum := sum + {a_ss[nom_[num,j]] *} ug_t[j]; if (znak[i] = '==') and ( abs( sum - b[i]) > 0.00000001 ) then yes_ := false; if (znak[i] = '<=') and (sum > b[i]) then yes_ := false; if (znak[i] = '>=') and (sum < b[i]) then yes_ := false; end; for i := 1 to ch_[num] do if ug_t[i] < 0 then yes_ := false; for i := 1 to cv_ug_[num] do begin fl := true; for j := 1 to ch_[num] do if ug_t[j] <> ug_t_[num,i,j] then fl := false; if fl then yes_ := false; end; end; procedure to_ug_t_; var i: integer; begin for i := 1 to ch_[num] do ug_t_[num,cv_ug_[num],i] := ug_t[i]; end; begin cv_ug_[num] := 0; for ll := 1 to ch_[num] do ug_t[ll]:=0; if yes_ then begin inc( cv_ug_[num]); to_ug_t_; end; for i := 1 to ch_[num] do for l := nach_[num] to end_[num] do begin for ll := 1 to ch_[num] do if ll <>i then ug_t[ll]:=0; ug_t[i] := b[l] / a_ss[l,nom_[num,i]]; if yes_ then begin inc( cv_ug_[num]); to_ug_t_; end; end; for i := 1 to ch_[num] do for j := i+1 to ch_[num] do begin for k := nach_[num] to end_[num] do for l := k+1 to end_[num] do begin for ll := 1 to ch_[num] do if (ll <> i) and (ll <> j ) then ug_t[ll] := 0; if a_ss[l,nom_[num,j]]-a_ss[l,nom_[num,i]]*a_ss[k,nom_[num,j]]/a_ss[k,nom_[num,i]] <> 0 then begin ug_t[j] := ( b[l]-b[k]*a_ss[l,nom_[num,i]]/a_ss[k,nom_[num,i]]) / (a_ss[l,nom_[num,j]]-a_ss[l,nom_[num,i]]* a_ss[k,nom_[num,j]]/a_ss[k,nom_[num,i]]); ug_t[i] := ( b[k]-a_ss[k,nom_[num, j]]*ug_t[j]) / a_ss[k,nom_[num,i]]; end else begin ug_t[i] := 0; ug_t[j] := 0; end; if yes_ then begin inc( cv_ug_[num]); to_ug_t_; end; end; end; end; var { Dialog :PDialog; RR : TRect; } as, aa_s: array [1 ..max_var] of PChar; a_s : array [1 ..max_var, 1..max_var] of PChar; { cc : word; } ll,lll: byte; begin repeat RR.Assign(3, 3, 77,17); Dialog := New( PDialog, Init( RR, 'Количество уравнений и неизвестных:')); with Dialog^ do begin for i := 1 to 2 do begin RR.Assign(55, 1+2*i, 65, 2+2*i); as[i] := New(PChar, Init( RR, 3, max_var)); Insert( as[i]); RR.Assign(5, 1+2*i, 53, 2+2*i); Insert( New( PLabel, Init( RR, Txt[i], as[i]))); end; RR.Assign( 10, 11, 25, 13); Insert( New( PButton, Init( RR,'Ok', cmOk, bfDefault))); RR.Assign( 46, 11, 64, 13); Insert( New( PButton, Init( RR,'Cancel', cmCancel, bfNormal))); SelectNext( false); end; CC := DeskTop^.ExecView( Dialog ); if CC = cmCancel then CCC := 2; if CC = cmOk then begin n := round( as[1]A.value); m := round( as[2]A.value); u :=0; u1 :=0; CC := cmCancel; ccc:= 1; end; Dispose( Dialog, Done); Until CC = cmCancel; if ccc = 2 then exit; repeat RR.Assign( 1,0,79,23); Dialog := New( PDialog, Init( RR, 'Матрица ограничений:')); with Dialog^ do begin for i := 1 to m do for j := 1 to n do begin RR.Assign( j*6-3, i*2,2+j*6, 1+i*2 ); a_s[i, j] := (New( PChar, Init( RR, 4, 999 ))); Insert( a_s[i, j]); end; RR.Assign(63, 18,77,20); Insert( New( PButton, Init( RR,'Ok', cmOk, bfDefault))); RR.Assign(63, 20, 77, 22); Insert( New( PButton, Init( RR,'Cancel', cmCancel, bfNormal))); SelectNext( false ) ; end; CC := DeskTop^.ExecView( Dialog ); if CC= cmCancel then CCC := 2; if CC=cmOk then begin for i := 1 to m do for j := 1 to n do a_ss[i,j] := a_s[i,j]^.value; cc := cmCancel; ccc:= I; end; Dispose( Dialog, Done); Until CC = cmCancel; j := l; nl :=255; while j <= n-u do begin i := 1; while i <= m do if a_ss[i j] <> 0 then inc( i) else begin ku:=i-l; if ku 0 then begin inc( ch_[s]); nom_[s,k] := j; inc( k ); end; fl := false; for j := 1 to ch_[s] do if a_ss[i+l,nom_[s,j]] = 0 then fl := true; if fl then begin inc( s ); ch_ur_[s] := 1; end else inc( ch_ur_[s]); end; ch_ur_[s] := 0; dec( s ); k := 0; ml := 0; end_[0]:=nl; for i := 1 to s do begin nach_[i] := end_[i-l] + 1; end_[i] := nach_[i] + ch_ur_[i] - 1 ; end; if ccc = 2 then exit; for i := 1 to m do begin if ccc = 2 then exit; repeat read_znak; Application^ .Redraw; if znak[i] = '' then begin ccc:= 2; exit; end; RR.Assign( 1,0,79,23); Dialog := New( PDialog, Init( RR, 'Столбец свободных членов:')); with Dialog^ do begin for lll := 1 to m do for j := 1 to n do begin str( a_ss[lll j]:l :1, nv); RR.Assign(j*6-3,111*2-1,2+j*6,111*2 ); Insert( New( PStaticText, Init( RR, nv)) ); end; for 11 := 1 to i do begin RR.Assign( 6*n+3,11*2-1, 6 *n+5,11*2 ); Insert( New( PStaticText, Init( RR, znak[ll]))); str(bpi]:l:l,nv); RR.Assign( 6*n+7,11*2-1, 6*n+12,11*2 ); Insert( New( PStaticText, Init( RR, nv ))); end; RR.Assign( 6*n+3, i*2-l, 6*n+5, i*2 ); Insert( New( PStaticText, Init( RR, znak[i]))); RR.Assign( 6*n+7, i*2-l, 6*n+12, i*2 ); aa_s[i] := ( New( PStr, Init( RR, 4, 999 ))); Insert( aa_s[i]); RR.Assign( 5, 20, 20, 22 ); Insert( New( PButton, Init( RR,'Ok1, cmOk, bfDefault))); RR Assign( 30, 20, 45, 22 ); Insert( New( PButton, Init( RR,'Cancel1, cmCancel, bfNormal))); SelectNext( false ); CC := DeskTop^.ExecView( Dialog ); if CC = cmCancel then ccc := 2; if CC = cmOk then begin b[i] := aa_s[i]^.value; CCC:= l; CC := cmCancel; end; end; Dispose(Dialog, Done); until CC = cmCancel; end; if CCC = 2 then exit; for i := 1 to s do fmd_ug_t( i); repeat RR.Assign(3, 7, 77,18); Dialog := New( PDialog, Init( RR, 'Целевая функция:')); with Dialog^ do begin for i := 1 to n do begin RR.Assign(3+i*6, 3, 8+i*6, 4); as[i] := (New( PStr, Init( RR, 4, 999 ))); Insert( as[i]); end; RR.Assign(5, 7, 20, 9); Insert( New( PButton, Init( RR,'Ok', cmOk, bfDefault))); RR.Assign(30, 7, 45, 9); Insert( New( PButton, Init( RR,'Cancel1, cmCancel, bfNormal))); SelectNext( false ); end; CC := DeskTop^.ExecView( Dialog ); if CC= cmCancel then CCC := 2; if CC= cmOk then begin for i := 1 to n do begin c[l,i] := as[i]^.value; if i<=n-u then c[2,i]:=0 else c[2,i]:=-l; end; cc := cmCancel; CCC:=1; end; Dispose( Dialog, Done ); Until CC = cmCancel; for i := 1 tonl do for j := 1 to n do a_bs[I,j] := a_ss[I,j]; end; begin myapp.init; myapp.run; myapp.done; end.