哪位兄弟可以将由C实现的“单纯形法”的过程---翻译成delphi的程序，贴内有C的源程序，谢谢参与！ ( 积分: 300 )

fphuang · 2005-05-17

/*本程序是单纯形法，参考书目:河海大学<吴凤平>运筹学方法与应用*/
#include<stdio.h>
#include<math.h>
#define X 5
#define Y 7
void xi_max(int *m2,int *mn1,float *c,int *is,int *ir,int *j0,float (*a)[X][Y])
{
int j;
*c=0;
for(j=1;j<=*is;j++)
{
if((*a)[*ir][j]-*c>0)
{
*c=(*a)[*ir][j];
*j0=j;
}
}
}

/***************** 参数说明 **********************/
/* m_约束方程个数(基变量个数),n_非基变量个数 */
/* m2-m+2整个变量,(*a)[X][Y]存放初始数据 */
/* (*k)[]存放基变量脚标,(*x)存放基变量最优值 */
/********* http://happyyangxu.home.sunbo.net*******/
int xi_sm(int m,int n,int m2,int mn1,int l1,float (*a)[X][Y],
int(*k)[],float(*x)[])
{
int i,m1,mn,j0,i0,j;
float c,g;
m1=m+1;
mn=m+n;
for(i=1;i<=m;i++)
(*k)=n+i;
leap1:
if(l1-1==0)
xi_max(&m2,&mn1,&c,&mn,&m1,&j0,a);
else
{
leap2: if(l1-50==0)
xi_max(&m2,&mn,&c,&n,&m2,&j0,a);
else
xi_max(&m2,&mn1,&c,&mn,&m2,&j0,a);
}
c-=1e-8;
if((c<=0)&&(l1==1)&&((*a)[m1][mn1]-1e-8>0))
{
printf("/n/t*********Not min&&No solution**********/n"
return(-1);
}
if((c<0)&&(l1==1))
{
l1=50;
goto leap2;
}
if(c<=0)
{
for(i=1;i<=m;i++)
(*x)=(*a)[mn1];
printf("/n/t********Optimal solution********/n"
for(i=1;i<=m;i++)
printf("/ni=%d,x=%f/n",(*k),(*x));
printf("/nF=%f/n",(*a)[m2][mn1]);
return 0;
}
c=1e8;
for(i=1;i<=m;i++)
{
if((*a)[j0]>1e-8)
{
g=(*a)[mn1]/(*a)[j0];
if(g-c<0);
{
c=g;
i0=i;
}
}
}
if(c==1e+8)
{
printf("/n/t*******Lp no solution********/n"
return -3;
}
(*k)[i0]=j0;
for(j=1;j<=mn1;j++)
{
if((j==j0)||(l1==50)&&(n<j)&&(j<mn1))
continue;
g=(*a)[i0][j]/(*a)[i0][j0];
(*a)[i0][j]=g;
for(i=1;i<=m2;i++)
{
if((i==i0)||(!(l1==1)&(i==m1)))
continue;
(*a)[j]=(*a)[j]-(*a)[j0]*g;
}
}
for(i=1;i<=m2;i++)
(*a)[j0]=0;
(*a)[i0][j0]=1;
goto leap1;
}
main()
{
float a[5][7]={{0,0,0, 0, 0,0,0},
{0,3,-4,3, 1,0,12},
{0,3,0, 6, 0,1,12},
{0,0,0, 0, 0,0,0},
{0,69,0,144,0,0,300}};
int k[3];
float x[3];
clrscr();
xi_sm(2,3,4,6,0,&a,&k,&x);
}

fphuang · 2005-05-17

/*本程序是单纯形法，参考书目:河海大学<吴凤平>运筹学方法与应用*/
#include<stdio.h>
#include<math.h>
#define X 5
#define Y 7
void xi_max(int *m2,int *mn1,float *c,int *is,int *ir,int *j0,float (*a)[X][Y])
{
int j;
*c=0;
for(j=1;j<=*is;j++)
{
if((*a)[*ir][j]-*c>0)
{
*c=(*a)[*ir][j];
*j0=j;
}
}
}

/***************** 参数说明 **********************/
/* m_约束方程个数(基变量个数),n_非基变量个数 */
/* m2-m+2整个变量,(*a)[X][Y]存放初始数据 */
/* (*k)[]存放基变量脚标,(*x)存放基变量最优值 */
/********* http://happyyangxu.home.sunbo.net*******/
int xi_sm(int m,int n,int m2,int mn1,int l1,float (*a)[X][Y],
int(*k)[],float(*x)[])
{
int i,m1,mn,j0,i0,j;
float c,g;
m1=m+1;
mn=m+n;
for(i=1;i<=m;i++)
(*k)=n+i;
leap1:
if(l1-1==0)
xi_max(&m2,&mn1,&c,&mn,&m1,&j0,a);
else
{
leap2: if(l1-50==0)
xi_max(&m2,&mn,&c,&n,&m2,&j0,a);
else
xi_max(&m2,&mn1,&c,&mn,&m2,&j0,a);
}
c-=1e-8;
if((c<=0)&&(l1==1)&&((*a)[m1][mn1]-1e-8>0))
{
printf("/n/t*********Not min&&No solution**********/n"
return(-1);
}
if((c<0)&&(l1==1))
{
l1=50;
goto leap2;
}
if(c<=0)
{
for(i=1;i<=m;i++)
(*x)=(*a)[mn1];
printf("/n/t********Optimal solution********/n"
for(i=1;i<=m;i++)
printf("/ni=%d,x=%f/n",(*k),(*x));
printf("/nF=%f/n",(*a)[m2][mn1]);
return 0;
}
c=1e8;
for(i=1;i<=m;i++)
{
if((*a)[j0]>1e-8)
{
g=(*a)[mn1]/(*a)[j0];
if(g-c<0);
{
c=g;
i0=i;
}
}
}
if(c==1e+8)
{
printf("/n/t*******Lp no solution********/n"
return -3;
}
(*k)[i0]=j0;
for(j=1;j<=mn1;j++)
{
if((j==j0)||(l1==50)&&(n<j)&&(j<mn1))
continue;
g=(*a)[i0][j]/(*a)[i0][j0];
(*a)[i0][j]=g;
for(i=1;i<=m2;i++)
{
if((i==i0)||(!(l1==1)&(i==m1)))
continue;
(*a)[j]=(*a)[j]-(*a)[j0]*g;
}
}
for(i=1;i<=m2;i++)
(*a)[j0]=0;
(*a)[i0][j0]=1;
goto leap1;
}
main()
{
float a[5][7]={{0,0,0, 0, 0,0,0},
{0,3,-4,3, 1,0,12},
{0,3,0, 6, 0,1,12},
{0,0,0, 0, 0,0,0},
{0,69,0,144,0,0,300}};
int k[3];
float x[3];
clrscr();
xi_sm(2,3,4,6,0,&a,&k,&x);
}

yjwnnit · 2005-05-17

这有什么难? 只是要花点时间, 给你鱼吃,还不如你自己知道捕鱼的方法.

你自己好好看看PASCALL的语法书吧, 相信学过C的你,一定会很快解决这个问题.

lichengbin · 2005-05-17

program Project4;

{$APPTYPE CONSOLE}

uses
SysUtils;

type
TDoubleArray = array[0..4, 0..6] of Double;

procedure xi_max(m2, mn1: Integer
var c: Double
_is, ir: Integer;
var j0: Integer
const a: TDoubleArray);
var
j: Integer;
begin
c := 0;
for j := 1 to _is do
begin
if (a[ir][j] - c > 0) then
begin
c := a[ir][j];
j0 := j;
end;
end;
end;

{
/***************** 参数说明 **********************/
/* m_约束方程个数(基变量个数),n_非基变量个数 */
/* m2-m+2整个变量,(*a)[X][Y]存放初始数据 */
/* (*k)[]存放基变量脚标,(*x)存放基变量最优值 */
/********* http://happyyangxu.home.sunbo.net*******/
}
function xi_sm(m, n, m2, mn1, l1: Integer
var a: TDoubleArray;
var k: array of Integer
var x: array of Double): Integer;
var
i,m1,mn,j0,i0,j: Integer;
c,g: Double;
leap2: Boolean;
begin
m1:=m+1;
mn:=m+n;
for i := 1 to m do
k:=n+i;
leap2 := False;
repeat
if leap2 then
begin
leap2 := False;
if(l1-50=0) then
xi_max(m2,mn,c,n,m2,j0,a)
else
xi_max(m2,mn1,c,mn,m2,j0,a);
end
else if (l1-1=0) then
xi_max(m2,mn1,c,mn,m1,j0,a);
c := c - 1e-8;
if((c<=0)and(l1=1)and(a[m1][mn1]-1e-8>0)) then
begin
Writeln(#13#9'*********Not min&&No solution**********');
Result := -1;
Exit;
end;
if((c<0)and(l1=1)) then
begin
l1:=50;
leap2 := True;
Continue;
end;
if(c<=0) then
begin
for i:=1 to m do
x:=a[mn1];
Writeln(#13#9'********Optimal solution********');
for i:=1 to m do
Writeln(#13'i=',k,',x=',x);
Writeln(#13'F=',a[m2][mn1]);
Result := 0;
Exit;
end;
c:=1e8;
i0:=0;
for i:=1 to m do
begin
if(a[j0]>1e-8) then
begin
g:=a[mn1]/a[j0];
if(g-c<0) then ;
begin
c:=g;
i0:=i;
end;
end;
end;
if(c=1e+8) then
begin
Writeln(#13#9'*******Lp no solution********');
Result := -3;
Exit;
end;
k[i0]:=j0;
for j:=1 to mn1 do
begin
if((j=j0)or(l1=50)and(n<j)and(j<mn1)) then
continue;
g:=a[i0][j]/a[i0][j0];
a[i0][j]:=g;
for i:=1 to m2 do
begin
if((i=i0)or (not(l1=1)and(i=m1))) then
continue;
a[j]:=a[j]-a[j0]*g;
end;
end;
for i:=1 to m2 do
a[j0]:=0;
a[i0][j0]:=1;
until False;
end;

var
a: TDoubleArray = (
(0,0,0, 0, 0,0,0),
(0,3,-4,3, 1,0,12),
(0,3,0, 6, 0,1,12),
(0,0,0, 0, 0,0,0),
(0,69,0,144,0,0,300));
k: array[0..2] of Integer;
x: array[0..2] of Double;
begin
xi_sm(2,3,4,6,0,a,k,x);
end.

fphuang · 2005-05-17

谢谢我明天试试

fphuang · 2005-05-18

接受答案了.

哪位兄弟可以将由C实现的“单纯形法”的过程---翻译成delphi的程序，贴内有C的源程序，谢谢参与！ ( 积分: 300 )

fphuang

Unregistered / Unconfirmed

fphuang

Unregistered / Unconfirmed

yjwnnit

Unregistered / Unconfirmed

lichengbin

Unregistered / Unconfirmed

fphuang

Unregistered / Unconfirmed

fphuang

Unregistered / Unconfirmed

Similar threads