lmdfxmainmain.pas

线性规划CAI应用程序及原代码

        button7.Enabled :=false;
        for i:= varnum-1 downto 0 do
           combobox3.Items.Delete(i); 
        for i:=leashnum-1 downto 0 do
           combobox2.Items.Delete(i);
	for i:=varnum*leashnum-1 downto 0 do
           combobox1.Items.Delete(i);
        
end;


//******************目标函数灵敏度分析**************************


function Tlmdmain.getclmd(a,b:string):string;
var x,y:string;          {M只可能出现在非基变量中}
begin
   if pos('M',a)>0 then
   begin
       x:=copy(b,(pos('M',b)-1),1);
       y:=copy(b,pos('M',b),length(b));
       if strtoint(x)=1 then
       getclmd:=copy(b,(pos('M',b)+1),length(b))
       else
       getclmd:=inttostr((-1)+strtoint(x))+y;
   end
   else
   getclmd:=floattostr(strtofloat(a)-strtofloat(b));
end;

function judgeifisbasevar(i:integer):boolean;
var j:integer;
begin
  judgeifisbasevar:=false;
  for j:=1 to varnum do
     if i=basevar[j] then
        judgeifisbasevar:=true;
end;

procedure Tlmdmain.calculateclmd(a:integer);
begin
     judgeifisbasevar(a);
     if judgeifisbasevar(a)=true then
         begin
              findbasenumc(a);
              findmin;
              getresultclmd;
         end
     else
         begin
                clmd:=getclmd(xigrid1.cells[a-1,1],czgrid1.cells[a-1,1]);
                if studymode then
                   if (edit6.text<>clmd)or(edit5.Text<>'负无穷') then
                   showmessage('灵敏度'+combobox3.text+'计算错误!');
                edit5.Text:='负无穷';
                edit6.Text:=clmd;
         end;

end;



procedure Tlmdmain.Button2Click(Sender: TObject);
var i:integer;
begin
     i:=combobox1.Items.IndexOf(combobox1.Text);
     if i<combobox1.Items.Count-1 then
     begin
     combobox1.text :=combobox1.Items.Strings[i+1];
     anum:=i+1;
     end;
    { if anum=(combobox1.Items.count-1)then
     begin
     button2.Enabled :=false;
     button5.enabled:=true;
     end;
    }
    combobox1change(sender);
end;
procedure Tlmdmain.Button5Click(Sender: TObject);
var i:integer;
begin
     i:=combobox1.Items.IndexOf(combobox1.Text);
     if i>0 then
     begin
     combobox1.text :=combobox1.Items.Strings[i-1];
     anum:=i-1;
     end;
    { if anum=0then
     begin
     button5.enabled:=false;
     button2.Enabled :=true;
     end;
    }
    combobox1change(sender);
end;
procedure Tlmdmain.Button3Click(Sender: TObject);
var i:integer;
begin
     i:=combobox2.Items.IndexOf(combobox2.Text);
     if i<combobox2.Items.Count-1 then
     begin
     combobox2.text :=combobox2.Items.Strings[i+1];
     bnum:=i+1;
     end;
{     if bnum=(combobox2.Items.count-1)then
     begin
     button3.Enabled :=false;
     button6.Enabled :=true;
     end;
     }
     combobox2change(sender);
end;
procedure Tlmdmain.Button6Click(Sender: TObject);
var i:integer;
begin
     i:=combobox2.Items.IndexOf(combobox2.Text);
     if i>0 then
     begin
     combobox2.text :=combobox2.Items.Strings[i-1];
     bnum:=i-1;
     end;
    { if bnum=0then
     begin
     button6.enabled:=false;
     button3.Enabled :=true;
     end;
     }
     combobox2change(sender);
end;
procedure Tlmdmain.Button4Click(Sender: TObject);
var i:integer;
begin
     i:=combobox3.Items.IndexOf(combobox3.Text);
     if i<combobox3.Items.Count-1 then
     begin
     combobox3.text :=combobox3.Items.Strings[i+1];
     cnum:=i+1;
     end;
 {    if cnum=(combobox3.Items.count-1)then
     begin
     button4.Enabled :=false;
     button7.enabled:=true;
     end;
  }   combobox3change(sender);
end;

procedure Tlmdmain.Button7Click(Sender: TObject);
var i:integer;
begin
     i:=combobox3.Items.IndexOf(combobox3.Text);
     if i>0 then
     begin
     combobox3.text :=combobox3.Items.Strings[i-1];
     cnum:=i-1;
     end;
    { if cnum=0then
     begin
     button7.enabled:=false;
     button4.Enabled :=true;
     end;
   }  combobox3change(sender);
end;

procedure Tlmdmain.ComboBox3Change(Sender: TObject);
begin
     cnum:=combobox3.Items.IndexOf(combobox3.Text)+1;
     calculateclmd(cnum);
     {if cnum<(combobox3.Items.Count-1)
         then button4.Enabled :=true
         else button4.Enabled :=false;
     if cnum>0
         then button7.Enabled :=true
         else button7.Enabled :=false;
     }
end;
procedure tlmdmain.findbasenumc(a:integer);
var i,j:integer;
begin
    for i:=1 to leashnum do
    begin
       j:=strtoint(copy(cxbgrid1.cells[1,i],2,1));
       if j=a then basenum:=i;
    end;
end;
procedure findmin;
var i,j,k:integer;
    l:extended;
    findpoint:boolean;
begin
    j:=0;
    for  k:= 0 to varnum-1 do
    begin
        i:=k;
       if (arraygrid1[i,basenum-1]<>'')then
        if (abs(strtofloat(arraygrid1[i,basenum-1]))>0.000001)and (c_z[i+1]<>0)and(pos('M',(lmdmain.czGrid1.Cells[i,1]))=0) then  {人工设定防止溢出}
        begin
        save_result_array[j]:= c_z[i+1]/strtofloat(arraygrid1[i,basenum-1]);
        j:=j+1;
        end
    end;
    for i:=0 to j-1 do{按从小到大的顺序排列}
        for k:=i to j-1 do
        begin
           l:=0;
           if save_result_array[i]>save_result_array[k] then
           begin
              l:=save_result_array[i];
              save_result_array[i]:=save_result_array[k];
              save_result_array[k]:=l;
           end;
        end;
    findpoint:=false;
    for i:=1 to j-1 do
    begin
         if (save_result_array[i]>0)and(save_result_array[i-1]<0) then findpoint:=true;
         if findpoint=true then
         begin
            clmdmax:=save_result_array[i];
            clmdmin:=save_result_array[i-1];
         end;
         if findpoint then break;
    end;
    if findpoint=false then
    begin
        if save_result_array[j-1]>0 then
        begin
            clmdmax:=save_result_array[0];
            clmdmin:=0;
        end
        else
        begin
            clmdmax:=0;
            clmdmin:=save_result_array[j-1];
        end;
    end;
    clmdmax:=clmdmax+strtofloat(arraygrid4[cnum-1]);
    clmdmin:=clmdmin+strtofloat(arraygrid4[cnum-1]);
end;
procedure getresultclmd;
var getlmd:extended;
begin
    if studymode then
       if (lmdmain.Edit5.Text<>floattostr(clmdmin))or(lmdmain.edit6.Text <>floattostr(clmdmax))then
       showmessage('灵敏度'+lmdmain.combobox3.text+'计算错误！');
    lmdmain.edit5.text:=floattostr(clmdmin);
    if clmdmax>bigm-1 then
    lmdmain.edit6.text:='正无穷'
    else
    lmdmain.Edit6.text:=floattostr(clmdmax);
end;

{*********************以上为对目标函数c 的灵敏度分析**************************************}
{*********************以下为对右端项b的灵敏度分析*****************************************}
procedure tlmdmain.findbasenumb(a:integer);
var i,j:integer;
begin
    basenum:=a;
end;

procedure findminb;
var i,j,k:integer;
    l:extended;
    findpoint:boolean;
begin
    j:=0;
    for  k:= 0 to afterleashnum-1 do
    begin
        i:=k;
        if (arraygrid1[basenum+varnum-1,i]<>'') then
        if (abs(strtofloat(arraygrid1[basenum+varnum-1,i]))>0.000001) then  {人工设定防止溢出}
        begin
        save_result_array[j]:= -1*strtofloat(b_value_array[i])/strtofloat(arraygrid1[basenum+varnum-1,i]);
        j:=j+1;
        end
    end;
    for i:=0 to j-1 do{按从小到大的顺序排列}
        for k:=i to j-1 do
        begin
           l:=0;
           if save_result_array[i]>save_result_array[k] then
           begin
              l:=save_result_array[i];
              save_result_array[i]:=save_result_array[k];
              save_result_array[k]:=l;
           end;
        end;
    findpoint:=false;
    for i:=1 to j-1 do
    begin
         if (save_result_array[i]>0)and(save_result_array[i-1]<0) then findpoint:=true;
         if findpoint=true then
         begin
            blmdmax:=save_result_array[i];
            blmdmin:=save_result_array[i-1];
            break;
         end;

    end;
    if findpoint=false then
    begin
        if save_result_array[j-1]>0 then
        begin
            blmdmax:=save_result_array[0];
            blmdmin:=0;
        end
        else
        begin
            blmdmax:=0;
            blmdmin:=save_result_array[j-1];
        end;
    end;
    blmdmax:=blmdmax+bp_old_b[bnum];
    blmdmin:=blmdmin+bp_old_b[bnum];
end;
procedure getresultblmd;
var getlmd:extended;
begin
    if studymode then
       if (lmdmain.Edit3.text<>floattostr(blmdmin))or(lmdmain.edit4.text<>floattostr(blmdmax))then
       showmessage('灵敏度'+lmdmain.combobox2.text+'计算错误！');
    lmdmain.edit3.text:=floattostr(blmdmin);
    lmdmain.Edit4.text:=floattostr(blmdmax);
end;

procedure Tlmdmain.calculateblmd(a:integer);
begin
     findbasenumb(a);
     findminb;
     getresultblmd;

end;

procedure Tlmdmain.ComboBox2Change(Sender: TObject);
begin
     bnum:=combobox2.Items.IndexOf(combobox2.Text)+1;
     calculateblmd(bnum);
end;

{*********************以上为对右端项b的灵敏度分析*****************************************}
{*********************以下为对技术系数a 的灵敏度分析**************************************}

procedure Tlmdmain.get_ij(a:string);
begin
     get_i:=(combobox1.Items.IndexOf(a)div varnum)+1;
     get_j:=(combobox1.items.indexof(a)mod varnum)+1;
end;

function judge_basevar(i:integer):boolean;
var j:integer;
begin
     {daizuo}
     judge_basevar:=false;
     for j:=1 to varnum do
         if i=basevar[j] then
            judge_basevar:=true;
end;

function b_is_over(i:integer):boolean;
var j:integer;
begin
    {daizuo}
    b_is_over:=true;
    for j:=1 to leashnum do
       begin
           if (basevar[j]=varnum+i)then
              begin
              b_is_over:=false;
              save_hang:=j;
              end;

       end;

end;

procedure Tlmdmain.getresultalmd(a,b:integer); {A为行，B为列}
var j:integer;
begin
     if judge_basevar(b) then
        if b_is_over(a) then
        begin
             almd:='0';
             if studymode then
               if (edit1.text<>almd)or(edit2.Text<>almd ) then
               showmessage('灵敏度'+combobox1.text+'计算错误！');
             edit1.text:=almd;
             edit2.text:=almd;
        end
        else
        begin
            for j:=1 to leashnum do
            begin
                 if basevar[j]=b then
                 begin
                      save_hang1:=j;
                 end;
            end;
           if cxbgrid1.Cells [2,save_hang1]<>'' then
            if (strtofloat(cxbgrid1.Cells [2,save_hang1])<>0) then
               begin
                almd:=floattostr(bp_old_a[b,a]+strtofloat(cxbgrid1.Cells[2,save_hang])/strtofloat(cxbgrid1.Cells [2,save_hang1]));
               end
            else
               almd:='正无穷';
            if studymode then
               if (edit1.text<>'负无穷')or(edit2.Text<>almd ) then
               showmessage('灵敏度'+combobox1.text+'计算错误！');
            edit1.Text:='负无穷';
            edit2.Text:=almd;
        end
     else
     begin
     if czgrid1.cells[varnum+a-1,0]<>'' then
         if (strtofloat(czgrid1.cells[varnum+a-1,0])<>0) then
            almd:=floattostr(bp_old_a[b,a]+strtofloat(czgrid1.cells[b-1,1])/strtofloat(czgrid1.cells[varnum+a-1,0]))
         else
            almd:='负无穷';
         if studymode then
               if (edit1.text<>almd)or(edit2.Text<>'正无穷' ) then
               showmessage('灵敏度'+combobox1.text+'计算错误！');
         edit2.text:='正无穷';
         edit1.text:=almd;
     end;
end;

procedure calculatealmd(a:string);

begin
     lmdmain.get_ij(a);
     lmdmain.getresultalmd(get_i,get_j);

end;

procedure Tlmdmain.ComboBox1Change(Sender: TObject);
begin
     anum:=combobox1.Items.IndexOf(combobox1.Text)+1;
     calculatealmd(combobox1.text);

end;


end.