Tài liệu tham khảo
XAC DINH GIA TRI TOIUU TONG QUAT CUA THONG SO DAU
Cac thong so vao toi uu dang ma x[1] = -1.15718115
x[2] = -0.05096484 x[3] = -0.05767439
Cac thong so vao toi uu dang thuc xt[1] = 24.21409425
xt[2] = 39.74517578 xt[3] = 2.08269768
XAC DINH GIA TRI TOI UU TONG QUAT CUA THONG SO DAU
Gia tri toi uu tong quat ham y1 : 0.25317987
RA
Phụ lục 5. Ch−ơng trình giải bài toán quy hoạch thực nghiệm và bài toán tối −u tổng quát
PROGRAM CHUONG_TRINH_QUI_HOACH_THUC_NGHIEM; Uses crt,printer,dos; Uses crt,printer,dos;
Const maxX = 31;maxY=31;maxZ = 5;
Type Mangx= Array[1..maxX,1..maxY] of real; MangY= Array[1..maxX] of real;
Mangz= Array[1..maxZ] of real; Mangh1= Array[1..6] of real;
Mangh2= Array[1..14,1..14] of real; Var X,c1,c2:mangx; y1,y2,y3,d1,d2,dt: mangy;
b1ij,b2ij,b3ij,b4ij,bc1,bc2,bc3,bc4,bdij,bcd :mangh2; b1i,b2i,b3i,b4i,bd2,bid:mangh1;
{Xo,esp,}xtu1,xtu2,xtu3,xtu4,xtud,xo,esp,xt: MangZ; i,j,i1,j1,N,p,no, Nb,N2,k,nn,ra: integer;
Q,a1,a2,a3,a4,a5,a6,a7,bo1,bo2,bo3,bo4,sao,fb,tb,bod: real; yz1,yz2,yz3,yz4,yt1d,yt2d,yzd:real; F,fl2: text; tentepsl,tentepkq,ch1,ch2,ch3,ch4,tm: string; Procedure Nhap; Begin clrscr;
writeln('Nhap so lieu tu tep ');
write('ten tep so lieu: ');readln(tentepsl); tentepsl:=tentepsl+'.pas';
writeln('Nhap so lieu tu tep ');
write('ten tep ket qua : ');readln(tentepkq); tentepkq:=tentepkq+'.pas'; assign(f,tentepsl); reset(f); N:= 0; i:= 0; readln(f,tm); readln(f,ch1); readln(f,ch2); {readln(f,ch3);} readln(f,k,sao,p,no,tb); for j:=1 to k do read(f,Xo[j]); for j:=1 to k do read(f,esp[j]); while not EOF(f) do
begin i:= i + 1; for j:= 1 to k do read(f,X[i,j]); readln(f,y1[i],y2[i]); end; N:= i; close(f); end; Procedure Hesothuc(bo:real;b:mangh1;b1:mangh2); var i,j,u:byte;ci:mangy;c1:mangx; g1,g2,g3,co :real; begin g1:=0.0;g2:=0; g3:=0.0;
for i:=1 to k do g1:=g1+b[i]*xo[i]/esp[i]; for i:=1 to k do for j:=i to k do g2:=g2+b1[i,j]*xo[i]*xo[j]/(esp[i]*esp[j]); Co:=bo-g1+g2; For i:=1 to k do begin g3:=0.0; for j:=1 to k do begin b1[j,i]:=b1[i,j];g3:=g3+b1[i,j]*xo[j]/(esp[i]*esp[j]);end; Ci[i]:=b[i]/esp[i]-g3-b1[i,i]*xo[i]/(esp[i]*esp[i]); for j:=i to k do C1[i,j]:=b1[i,j]/(esp[i]*esp[j]); end;
writeln(fl2,'':10,'Co = ',Co:2:8);
for i:=1 to k do writeln(fl2,'':10,'C',i,' = ',Ci[i]:2:8); for i:=1 to k-1 do
for j:=i+1 to k do writeln(fl2,'':10,'C',i,j,' = ',C1[i,j]:2:8);
for i:=1 to k do writeln(fl2,'':10,'C',i,i,' = ',C1[i,i]:2:8); End;
Procedure heso(ch:string;y:mangy;IJ:byte;var bo:real; var b:mangh1;var b1:mangh2);
var q1,q2,q3,t, sr,sf,yo,yhq,sy,se,sbo,sbi,sbij,sbii, c1,c2,d4,d1,d2,d3,f2,Ft,f1,ttt1 :real;f12:text;
u:integer;l,l1,l2,l3,tt,dt2:mangh1;tt1:mangx;ytt:mangy; Begin
Writeln(fl2,'':4,'QUY HOACH THUC NGHIEM MAY ',tm );
Writeln(fl2,'':10);
Writeln(fl2,'':10,'He so phuong trinh hoi quy dang ma '); Writeln(fl2,'':10);
f2:= no-1;
se:=0.0;sy:=0.0;yo:=0;sbo:=0.0;sbi:=0.0;sr:=0.0;sf:=0.0; sbij:=0.0;sbii:=0.0;c1:=0.0; c2:=0.0;d4:=0.0;
q1:=exp((k-p)*ln(2));q2:=sqr(k-sao*sao); q3:=sqr(sao*sao); a2:=1/(q1+2*sao*sao); a3:=1/q1; a4:=1/(2*q3);
a5:=(q1+2*sao*sao)/(2*q2*q1+(k*q1+2*q3)*no); a6:=(N*a2*a5-a4)/k;
a1:=(k*q1+2*q3)/(2*q2*q1+(k*q1+2*q3)*no); a7:=a6+a4;
for i:=N-no+1 to N do begin yo:=yo+y[i];end; yo:=yo/no;
for i:=N-no+1 to N do begin Se:=Se+sqr(y[i]-yo);end; Sy:=sqrt(Se/f2);
{Sbo:=a1*Sy;Sbi:=a2*Sy;Sbij:=a3*Sy;Sbii:=a7*Sy;} for i:=1 to N do begin c1:=c1+y[i]; end;
For i:=1 to k do begin
l[i]:=0;
for u:=1 to N do begin l[i]:=l[i]+x[u,i]*x[u,i]*y[u];end; c2:=c2+l[i];
end;
bo:=c1*a1-a5*c2; ttt1:=abs(bo)/(Sy*Sqrt(a1)); if ttt1>=tb then
begin nn:=1; Writeln(fl2,'':10,'bo = ',bo:2:7,'':5,' t0 = ',ttt1 :2:7,' Co nghia '); end
else begin bo:=0; Writeln(fl2,'':10,'bo = ',bo:2:9,':5','t0 = ',ttt1:2:7,' Khong co nghia ');end; for i:=1 to k do
begin
l1[i]:=0.0;
for u:=1 to N do begin l1[i]:=l1[i]+x[u,i]*y[u]; end; b[i]:=l1[i]*a2;tt[i]:=abs(b[i])/(Sy*Sqrt(a2));
if tt[i]>=tb then
begin nn:=nn+1 ;Writeln(fl2,'':10,'b',i:1,' = ',b[i]:2:7,'':5,' t',i,' = ',tt[i]:2:7,' Co nghia '); end
else begin Writeln(fl2,'':10,'b',i:1,' = ',b[i]:2:7,'':5,' t',i,' = ',tt[i]:2:7,' Khong Co nghia ');b[i]:=0; end;
end;
for i:=1 to k-1 do for j:=i+1 to k do begin
l2[i]:=0.0;
for u:=1 to N do begin L2[i]:=l2[i]+x[u,i]*x[u,j]*y[u];end; b1[i,j]:=l2[i]*a3; tt1[i,j]:=abs(b1[i,j])/(Sy*Sqrt(a3)); if tt1[i,j]>=tb then begin nn:=nn+1; Writeln(fl2,'':10,'b',i:1,j:1,' =
',b1[i,j]:2:7,'':5,'t',i:1,j:1,' = ',tt1[i,j]:3:7,' Co nghia '); end else begin
Writeln(fl2,'':10,'b',i:1,j:1,' =
',b1[i,j]:2:7,'':5,'t',i:1,j:1,'= ',tt1[i,j]:3:7,' Khong Co nghia ');b1[i,j]:=0;end;
end;
for i:=1 to k do begin
l3[i]:=0.0;
for u:=1 to N do begin l3[i]:=l3[i]+x[u,i]*x[u,i]*y[u]; end; b1[i,i]:=a4*l3[i]-c1*a5+a6*c2; tt1[i,i]:=abs(b1[i,i])/(Sy*Sqrt(a4+a6)); if tt1[i,i]>=tb then begin nn:=nn+1; Writeln(fl2,'':10,'b',i:1,i:1,' =
',b1[i,i]:2:7,'':5,'t',i:1,i:1,'= ',tt1[i,i]:3:7, ' Co nghia '); end else begin
Writeln(fl2,'':10,'b',i:1,i:1,' = ',b1[i,i]:2:7,'':5,'t',i:1,i:1,'= ',tt1[i,i]:3:7,' Khong Co nghia ');b1[i,i]:=0;end;
end; sr:=0.0; for u:=1 to N do begin d1:=0.0;d2:=0.0;d3:=0.0; for i:=1 to k do begin d1:=d1+b[i]*x[u,i]; d2:=d2+b1[i,i]*x[u,i]*x[u,i]; end; for i:=1 to k-1 do begin forj:=i+1 to k do begin d3:=d3+b1[i,j]*x[u,i]*x[u,j];end; end;
d4:=bo+d1+d2+d3; ytt[u]:=d4; dt2[u]:= sqr(d4-y[u]); Sr:=Sr+sqr(d4-y[u]);
writeln(fl2,'':5);
Writeln(fl2,'':10,'He so phuong trinh hoi quy dang thuc '); hesothuc(bo,b,b1);
writeln(fl2,'':5);
writeln(fl2,'':10,'MA TRAN THI NGHIEM VA KET QUA TINH TOAN ',ch);
writeln(fl2,'':20,'( XAY DUNG THEO PHUONG AN BOX-WILSON ) '); writeln(fl2,'':2,'______________________________________________________' ); writeln(fl2,'':2,'| | | | |',ch ); writeln(fl2,'':2,'| N | X1 | X2 | X3 |--- |');
writeln(fl2,'':2,'| | | | | THI NGHIEM | TINH TOAN |DO LECH BF|');
writeln(fl2,'':2,'|--- |');
for i:= 1 to N do begin
write(fl2,'':2,'|',i:2,' |'); begin
for j:= 1 to K do
If x[i,j]<0 Then write(fl2,' ',x[i,j]:2:0,' |') else write(fl2,' ',x[i,j]:2:0,' |');
writeln(fl2,' ',y[i]:6:2,' | ',' ',ytt[i]:6:4,' |', '':3,dt2[i]:6:7,' |'); end; end; writeln(fl2,'':2,'|--- |'); writeln(fl2,'':36,'Se =',Se:2:6,'':3,'Sr = ',Sr:2:6); writeln(fl2,'':40); f1:=N-nn-no+1; Sf:=(sr-se)/f1; Ft:=sf/sy;
Writeln(fl2,'':4,'QUY HOACH THUC NGHIEM MAY ',tm); writeln(fl2,'':40);
Writeln(fl2,'':5,'KIEM TRA TINH TUONG THICH CUA MO HIMH TOAN');
writeln(fl2,'':40);
writeln(fl2,'':10,'Bac tu do f1 = ',f1:2:2);
writeln(fl2,'':10,'Phuong sai thuc ung Stu = ',Sf:2:4); writeln(fl2,'':10,'Ty so giua phuong sai thich ung/ phuong sai thi nghiem F = ',Ft:2:2);
write('':10,'Tra bang tieu chuan Fisher Fb,0.05,',f1:2:0,',',f2:2:0,' Fb = ');read(Fb);
writeln(fl2,'':10,'Gia tri Fb tra bang theo tieu chuan Fisher Fb : ',Fb:2:2);
writeln(fl2,'':40);
If Ft<=Fb then writeln(fl2,'':5,'*** KET LUAN : Mo hinh thich ung ')
else writeln(fl2,'':5,' *** KET LUAN :Mo hinh khong thich ung ');
writeln(fl2,'':40);
writeln(fl2,'':10,'XAC DINH GIA TRI TOI UU CUA ',CH); writeln(fl2,'':40);
End;
Procedure dj(c:mangy;var dj:mangy); Var Yjm,Yjo,kk :real;
Begin
write('':10,'Chon gia tri cua Yjmin : ');readln(Yjm); write('':10,'Chon gia tri cua Yjo : ');readln(Yjo); write('':10,'Nhap gia tri yeu tien k: '); readln(kk);
For i:=1to N do dj[i]:=exp(-exp(-(kk*(c[i]-Yjm)/(Yjo-Yjm)))); End;
Procedure DTq32(c1,c2:mangy;var D:mangy); Begin
For i:=1 to N do D[i]:=exp(ln(c1[i]*c2[i])/2); End;
Procedure MTTU32(c1,c2,c3,c4,c5:mangy; ch:string); Begin
writeln(fl2,'':5);
writeln(fl2,'GIA TRI TINH TOAN HAM TOI UU TONG QUAT D ');
writeln(fl2,'___________________________________________________________' );
writeln(fl2,'| | | | | HAM TOI UU TONG QUAT D ',ch ); writeln(fl2,'| N | X1 | X2 | x3 |--- |'); writeln(fl2,'| | | | | y1 | y2 | d1 | d2 | D | '); writeln(fl2,'|--- |');
for i:= 1 to N do begin write(fl2,'|',i:3,' |'); begin
for j:= 1 to K do
If x[i,j]<0 Then write(fl2,' ',x[i,j]:4:0,' |') else write(fl2,' ',x[i,j]:4:0,' |');
write(fl2,c1[i]:2:2,' | ',c2[i]:2:2,' |',' |');
writeln(Fl2,c3[i]:2:2,' | ',c4[i]:2:2,' |',c5[i]:2:2,' |'); end; end; writeln(fl2,'|--- |'); End;
Procedure chs(b:mangh2;c:mangh1;k:integer;var b1:mangh2); var i,j,nt,ii:integer;
begin
for i:=1 to k do begin
for j:=i to k do
if i=j then b1[i,j]:=2*b[i,i] else begin b1[i,j]:=b[i,j];b1[j,i]:=b1[i,j]; end; b1[i,k+1]:=c[i]; end; end;
Procedure toiuu(a:mangh2;l:integer; var x,xt:mangZ); var i,j,k:integer;du1,du2:boolean;c,pp:real; begin
du2:=true;
While du2 and (i<l) do Begin if a[i,i]=0 then begin du1:=true; k:=i+1;
While du1 and (k<=l) do if a[k,i]<>0 then begin for j:=1 to l+1 do begin c:=a[i,j]; a[i,j]:=a[k,j]; a[k,j]:=c; end; du1:=false; end else k:=k+1; if (k=l+1) then begin if a[i,k]=0
then Writeln(' HE VO DINH ') else Writeln(' HE VO NGHIEM '); du2:=false; end; end; if a[i,i]<>0 then begin c:=a[i,i];
for j:=i+1 to l+1 do a[i,j]:=a[i,j]/c; for k:=i+1 to l do
begin
C:=a[k,i];
for j:=i+1 to l+1 do a[k,j]:=a[k,j]-a[i,j]*c; end; end; i:=i+1; end; if du2 then begin x[l]:=a[l,l+1]/a[l,l]; for i:=l-1 downto 1 do begin
x[i]:=a[i,l+1];
for j := l downto i+1 do x[i]:=x[i]-a[i,j]*x[j]; end;
for i:=1 to l do x[i]:=-x[i];
Writeln(fl2,'':10,'Cac thong so vao toi uu dang ma '); For i:=1 to l do writeln(fl2,'':10,'x[',i,'] = ',x[i]:2:8); Writeln(fl2,'':10,'Cac thong so vao toi uu dang thuc '); For i:=1 to l do begin
Xt[i]:=x[i]*esp[i]+Xo[i];
writeln(fl2,'':10,'xt[',i,'] = ',xt[i]:2:8); end;
end;
Procedure cuctri(bo:real;b1:mangh2;b2:mangh1;r:mangz;var yz:real); var c1,c2,c3 :real;i,j,nt:byte; begin c1:=0.0;c2:=0.0;c3:=0.0; for i:=1 to k do begin c1:=c1 +b2[i]*r[i]; c2:=c2+b1[i,i]*r[i]*r[i]; end; for i:=1 to k-1 do for j:=i+1 to k do begin c3:=c3+b1[i,j]*r[i]*r[j]; end; Yz:=bo+c1+c2+c3; Writeln(fl2,'':2,yz:2:8); End;
Procedure cuctritq(bo:real;b1:mangh2;b2:mangh1;r:mangz;var yz:real); var c1,c2,c3 :real;i,j,nt:byte; begin c1:=0.0;c2:=0.0;c3:=0.0; for i:=1 to k do begin c1:=c1 +b2[i]*r[i]; c2:=c2+b1[i,i]*r[i]*r[i]; end; for i:=1 to k-1 do for j:=i+1 to k do begin c3:=c3+b1[i,j]*r[i]*r[j]; end; Yz:=bo+c1+c2+c3; Writeln(fl2,'':2,yz:2:8); End; BEGIN clrscr; Nhap; assign(fl2,tentepkq);rewrite(fl2); heso(ch1,y1,1,bo1,b1i,b1ij); chs(b1ij,b1i,k,bc1); toiuu(bc1,k,xtu1,xt); writeln(fl2,'':40);
Write(fl2,'':10,'Gia tri toi uu cua ',ch1, ' la :'); cuctri(bo1,b1ij,b1i,xtu1,yz1); writeln(fl2,'':40); writeln(fl2,'':40); heso(ch2,y2,2,bo2,b2i,b2ij); chs(b2ij,b2i,k,bc2); toiuu(bc2,k,xtu2,xt); writeln(fl2,'':40);
Write(fl2,'':10,'Gia tri toi uu cua ',ch2, ' la :'); cuctri(bo2,b2ij,b2i,xtu2,yz2); writeln(fl2,'':40); writeln(fl2,'':40); dj(y1,d1);dj(y2,d2); dtq32(d1,d2,dt); mttu32(y1,y2,d1,d2,dt,ch4); heso(ch4,Dt,3,bod,bid,bdij);
chs(bdij,bid,k,bcd); toiuu(bcd,k,xtud,xt); writeln(fl2,'':40);
Write(fl2,'':10,'Gia tri toi uu tong quat ra :'); cuctri(bod,bdij,bid,xtud,yzd);
Write(fl2,'':10,'Gia tri toi uu tong quat dang thuc ham y1 :'); cuctritq(bo1,b1ij,b1i,xtud,yt1d);
Write(fl2,'':10,'Gia tri toi uu tong quat dang thuc ham y2 :'); cuctritq(bo2,b2ij,b1i,xtud,yt2d);
close(fl2); END.
