|
|
Регистрация Восстановить пароль |
Регистрация | Задать вопрос |
Заплачу за решение |
Новые сообщения |
Сообщения за день |
Расширенный поиск |
Правила |
Всё прочитано |
|
Опции темы | Поиск в этой теме |
10.02.2009, 19:29 | #1 |
Регистрация: 10.02.2009
Сообщений: 6
|
Задачи целочисленного линейного программирования
Кто знает где можно взять исходники Delphi на задачу:
На арматурный цех ЖБИ поступает пруток длиной 9 метров. Из этого прутка нарезать заготовки 2–х видов: А – длиной 2.3(20 шт) метра и Б - длиной 1.5(30 шт) метров. Какое наименьшее количество прутков необходимо нарезать, чтобы выполнить производственную программу? Решается Симплекс методом и методом Гомори. Кто чо знает пишите... |
19.02.2009, 12:23 | #3 |
Заблокирован
Регистрация: 19.02.2009
Сообщений: 11
|
вот могу помочь этим програмка на паскале, в делфи легко перегоняется, но огранич на у равнения 15 шт
PROGRAM SIMPLEX_METOD;
USES CRT; LABEL ZN,ST,ELL,_END; TYPE MAS=ARRAY[1..30] OF REAL; MASB=ARRAY[1..30] OF STRING[3]; MASX=ARRAY[1..30,1..30] OF REAL; VAR Fo,FunctPr,B,H,Hnew,C,Cnew,CPr,CPrn ew,FX:MAS; X,Xnew:MASX; BS,Bvsp,ZNAC:MASB; MIN,I1,I,J,Kx,Ky,Kit,NachKell,NachY ,K_st:INTEGER; PriznacY,KLstr,KLst,ErrCode,Dop_X:I NTEGER; P,P1,Mo,F0,Epsilon,Z:REAL; VSP,S,PrGomory:STRING; F:TEXT; DPx,DPy,Fm,Kell,Kstr:INTEGER; { Функция создания индексов } FUNCTION SIMVB(V:INTEGER;S:CHAR):STRING; VAR M,Z:STRING; BEGIN STR(V,M); Z:=S+M; SIMVB:=Z; END; { Процедура записи данных в файл } PROCEDURE SAVE(X1:REAL;K:STRING;Mstr:INTEGER) ; VAR V:STRING; BEGIN ASSIGN(F,'SIMPLEX.txt'); APPEND(F); CASE Mstr OF 0:WRITELN(F,''); 1:BEGIN IF K=' ' THEN STR(X1:1:0,V) ELSE STR(X1:10:4,V); WRITE(F,V); WRITE(F,' '); END; 2:WRITE(F,K); 3:WRITELN(F,K); END; CLOSE(F); END; { Определение дополнительных переменных } PROCEDURE DOP_PER; BEGIN IF ZNAC[I1]='=' THEN BEGIN Kell:=Kell+1;Bvsp[Kell]:=SIMVB(DPy,'Y'); DPy:=DPy+1; Xnew[I1,Kell]:=1; IF Fm=1 THEN FX[Kell]:=-1 ELSE FX[Kell]:=1; FunctPr[Kell]:=1; FOR I:=1 TO Kstr DO IF I<>I1 THEN Xnew[I,Kell]:=0; END; IF ZNAC[I1]='>=' THEN BEGIN Kell:=Kell+1;Bvsp[Kell]:=SIMVB(DPx,'X'); DPx:=DPx+1;Dop_X:=Dop_X+1; Xnew[I1,Kell]:=-1;FX[Kell]:=0; FOR I:=1 TO Kstr DO IF I<>I1 THEN Xnew[I,Kell]:=0; Kell:=Kell+1;Bvsp[Kell]:=SIMVB(DPy,'Y'); DPy:=DPy+1; Xnew[I1,Kell]:=1; IF Fm=1 THEN FX[Kell]:=-1 ELSE FX[Kell]:=1; FunctPr[Kell]:=1; FOR I:=1 TO Kstr DO IF I<>I1 THEN Xnew[I,Kell]:=0; END; IF ZNAC[I1]='<=' THEN BEGIN Kell:=Kell+1;Bvsp[Kell]:=SIMVB(DPx,'X'); DPx:=DPx+1;Dop_X:=Dop_X+1; Xnew[I1,Kell]:=1;FX[Kell]:=0; FOR I:=1 TO Kstr DO IF I<>I1 THEN Xnew[I,Kell]:=0; END; END; { Процедура сокращения Y } PROCEDURE SOKR; VAR P:INTEGER; BEGIN Kell:=Kell-1; FOR P:=NachKell+DOP_X TO Kell DO IF Bvsp[P]=BS[KLstr] THEN BEGIN FOR J:=P TO Kell DO Bvsp[J]:=Bvsp[J+1]; FunctPr[J]:=FunctPr[J+1]; Fx[J]:=Fx[J+1]; FOR I:=1 TO Kstr DO Xnew[I,J]:=Xnew[I,J+1] END; END; { Процедура, выполняющая метод Гомори } PROCEDURE GOMORY; VAR MAX,Z:REAL; BEGIN KLstr:=1; MAX:=H[1]-INT(H[1]); FOR I1:=2 TO Kstr DO IF (H[I1]-INT(H[I1]))>=MAX THEN BEGIN MAX:=H[I1]; KLstr:=I1;END; Kstr:=Kstr+1; Hnew[Kstr]:=H[KLstr]-INT(H[KLstr]); FOR I1:=1 TO Kell DO BEGIN Z:=INT(X[KLstr,I1]); IF X[KLstr,I1]<0 THEN Z:=Z-1; Xnew[Kstr,I1]:=X[KLstr,I1]-Z; END; ZNAC[Kstr]:='>='; END; { Процедура, выполняющая Симплекс метод } PROCEDURE SIMPLEX; LABEL POVZNAC,NACH; BEGIN { Подготовка к вводу данных } NachKell:=Kell; DPx:=Kell+1;DPy:=1; Kx:=1;Ky:=4; Epsilon:=0.00001; CLRSCR; WRITELN('wwedite sistemu urawnenii:'); WRITELN('(koeff pri vsex Х,znak i svobod chleny)'); { Ввод данных } FOR I:=1 TO Kstr DO BEGIN POVZNAC: WRITELN('vvedite ',I,'-е ur-e:'); { Ввод коэффициентов при X в I-том уравнении } FOR J:=1 TO Kell DO BEGIN GOTOXY(Kx,Ky);Kx:=Kx+6; READLN(Xnew[I,J]); END; { Ввод знака в I-том уравнении } Kx:=Kx+6;GOTOXY(Kx,Ky);READLN(ZNAC[I]); {Проверка введенного знака на правильность} IF (ZNAC[I]<>'>=') AND (ZNAC[I]<>'=') AND (ZNAC[I]<>'<=') THEN BEGIN WRITELN('neprav zadan znak'); Ky:=Ky+3;Kx:=1; GOTO POVZNAC; END; IF (ZNAC[I]='=') OR (ZNAC[I]='>=') THEN PriznacY:=1; { Ввод свободного члена в I-том уравнении } Kx:=Kx+6;GOTOXY(Kx,Ky);READ(B[I]); Kx:=1; Ky:=Ky+2; END; |
19.02.2009, 12:24 | #4 |
Заблокирован
Регистрация: 19.02.2009
Сообщений: 11
|
WRITELN('vvedite koeff celevoi function');
{ Ввод коэффициентов при Х в целевой функции } FOR J:=1 TO Kell DO BEGIN GOTOXY(Kx,Ky);Kx:=Kx+6; READ(FX[J]); END; { Подготовка индексации X } FOR J:=1 TO Kell DO Bvsp[J]:=SIMVB(J,'X'); { Определение дополнительных переменных } FOR I1:=1 TO Kstr DO DOP_PER; { Замена оптимальной функции с MAX на MIN при наличии в базисе Y-ков если идет исследование на минимум } MIN:=0; IF (Fm=1) AND (PriznacY=1) THEN BEGIN MIN:=Fm;Fm:=2; FOR J:=1 TO Kell DO FX[J]:=-FX[J]; END; { Сортировка дополнительных переменных по индексу } FOR I1:=NachKell+1 TO Kell DO FOR J:=I1+1 TO Kell DO IF Bvsp[J]<Bvsp[I1] THEN BEGIN VSP:=Bvsp[J];Bvsp[J]:=Bvsp[I1];Bvsp[I1]:=VSP; P:=FX[J];FX[J]:=FX[I1];FX[I1]:=P; P:=FunctPr[J];FunctPr[J]:=FunctPr[I1];FunctPr[I1]:=P; FOR I:=1 TO Kstr DO BEGIN P:=Xnew[I,I1];Xnew[I,I1]:=Xnew[I,J];Xnew[I,J]:=P; END; END; Kit:=1; CLRSCR; { Подготовка столбцов C,B,H } FOR I:=1 TO Kstr DO BEGIN Hnew[I]:=B[I]; FOR J:=NachKell+1 TO Kell DO IF Xnew[I,J]=1 THEN BEGIN BS[I]:=Bvsp[J]; Cnew[I]:=FX[J]; CPrnew[I]:=FunctPr[J]; END; END; NACH:; REPEAT PriznacY:=0; { Передача данных в исходные переменные c обнулением чисел, по модулю меньших чем 0.00001 } FOR I:=1 TO Kstr DO BEGIN IF INT(10000*Hnew[I])=0 THEN H[I]:=+0 ELSE H[I]:=Hnew[I]; C[I]:=Cnew[I]; CPr[I]:=CPrnew[I]; IF BS[I][1]='Y' THEN PriznacY:=1; FOR J:=1 TO Kell DO IF INT(10000*Xnew[I,J])=0 THEN X[I,J]:=+0 ELSE X[I,J]:=Xnew[I,J]; END; { Обнуление и вывод индексации элементов индексной строки } SAVE(0,' C Б H ',2); FOR J:=1 TO Kell DO BEGIN SAVE(0,Bvsp[J],2); P1:=LENGTH(Bvsp[J]); IF P1=2 THEN SAVE(0,' ',2); SAVE(0,' ',2); Fo[J]:=0; END; SAVE(0,'',0); { Вывод Симплекс-таблицы } P1:=0; FOR I:=1 TO Kstr DO BEGIN IF CPr[I]=1 THEN IF C[I]<0 THEN SAVE(0,'-M ',2) ELSE SAVE(0,'+M ',2) ELSE SAVE(C[I],'',1); SAVE(0,BS[I],2); P1:=LENGTH(BS[I]); IF P1=2 THEN SAVE(0,' ',2); SAVE(0,' ',2);SAVE(H[I],'',1); FOR J:=1 TO Kell DO SAVE(X[I,J],'',1); SAVE(0,'',0); END; { Вычисление значений в индексной строке } F0:=0; FOR J:=1 TO Kell DO Fo[J]:=0; FOR I1:=1 TO Kstr DO BEGIN IF PriznacY=1 THEN IF BS[I1][1]='Y' THEN BEGIN F0:=F0+H[I1]; FOR J:=1 TO Kell DO Fo[J]:=Fo[J]+X[I1,J]; END; IF PriznacY=0 THEN BEGIN F0:=F0+H[I1]*C[I1]; FOR J:=1 TO Kell DO Fo[J]:=Fo[J]+C[I1]*X[I1,J]; END; FOR J:=1 TO Kell DO IF Bvsp[J][1]='Y' THEN Fo[J]:=+0 ELSE IF ABS(Fo[J])<Epsilon THEN Fo[J]:=+0; END; { Вывод значений целевой функции } SAVE(0,' ',2);SAVE(F0,'',1); FOR J:=1 TO Kell DO BEGIN IF PriznacY<>1 THEN Fo[J]:=Fo[J]-FX[J]; SAVE(Fo[J],'',1); END; SAVE(0,'',0); { Проверка условия оптимальности } P:=0; FOR J:=1 TO Kell DO IF Fm=1 THEN IF Fo[J]<-Epsilon THEN BEGIN P:=1; CONTINUE; END ELSE ELSE IF Fo[J]>Epsilon THEN BEGIN P:=1; CONTINUE; END; IF P<>1 THEN BEGIN SAVE(0,'В ',2);SAVE(Kit,' ',1); SAVE(0,'-y iterazii bylo polucheno optimal rechenie ',3); SAVE(0,'t/k pri iisledovanii',2); IF Fm=1 THEN SAVE(0,' maximum indexnay stroka ne sodergit otrizat elementov',3) ELSE SAVE(0,'min indexnay stroka ne sodergit pologit elementov',3); FOR I1:=1 TO Kstr DO IF BS[I1][1]='Y' THEN BEGIN SAVE(0,'no tak kak iz bazisa ne vyvedeny vse Y, to ',3); SAVE(0,'rechenii net',3); HALT; END; { Округление значений массива Х до целого числа, если разность округленного и обычного значений по модулю меньше чем 0.00001 } FOR I:=1 TO Kstr DO BEGIN Z:=ROUND(H[I]); IF ABS(Z-H[I])<Epsilon THEN H[I]:=ROUND(H[I]); FOR J:=1 TO Kell DO BEGIN IF X[I,J]<0 THEN Z:=ROUND(X[I,J]); IF ABS(Z-X[I,J])<Epsilon THEN X[I,J]:=ROUND(X[I,J]); END; END; { Проверка целочисленности решения } P1:=0; FOR I:=1 TO Kstr DO BEGIN IF INT(10000*FRAC(H[I]))<>0 THEN BEGIN P1:=1;CONTINUE; END; |
19.02.2009, 12:24 | #5 |
Заблокирован
Регистрация: 19.02.2009
Сообщений: 11
|
FOR J:=1 TO Kell DO
IF BS[I]=Bvsp[J] THEN FOR I1:=1 TO Kstr DO IF ABS(FRAC(X[I1,J]))>=Epsilon THEN BEGIN P1:=1;CONTINUE; END; END; { Составление новой базисной строки для целочисленного решения } IF (PrGomory='Y') AND (P1=1) THEN BEGIN GOMORY; NachKell:=Kell; I1:=Kstr;DPy:=1; DOP_PER; BS[Kstr]:=Bvsp[Kell]; CPrnew[Kstr]:=FunctPr[Kell]; Cnew[Kstr]:=FX[Kell]; GOTO NACH; END; IF P1=0 THEN SAVE(0,'celochislennoe rechenie',3); SAVE(0,'pri etom:',3); IF MIN=1 THEN BEGIN F0:=-F0;Fm:=MIN; END; IF Fm=1 THEN SAVE(0,'Fmax=',2) ELSE SAVE(0,'Fmin=',2); SAVE(F0,'',1); SAVE(0,'',0); FOR I1:=1 TO Kstr DO BEGIN SAVE(0,' ',2); SAVE(0,BS[I1],2);SAVE(0,'=',2); SAVE(H[I1],'',1); SAVE(0,'',0); END; HALT; END; { Нахождение ключевого столбца } KLst:=1;Mo:=0; FOR J:=1 TO Kell DO IF Fm=1 THEN IF Fo[J]<Mo THEN Mo:=Fo[J]; FOR J:=1 TO Kell DO BEGIN IF Bvsp[J][1]<>'Y' THEN IF Fm=1 THEN BEGIN IF Fo[J]<0 THEN IF Fo[J]>=Mo THEN BEGIN Mo:=Fo[J]; KLst:=J; END; END ELSE BEGIN IF Fo[J]>0 THEN IF Fo[J]>=Mo THEN BEGIN Mo:=Fo[J]; KLst:=J; END; END; END; SAVE(0,'klychevoi stolbez: ',2);SAVE(KLst,' ',1); { Нахождение ключевой строки } P1:=0;K_st:=0; FOR J:=1 TO Kell DO IF ABS(Mo-Fo[J])<Epsilon THEN BEGIN K_st:=K_st+1; FOR I:=1 TO Kstr DO IF X[I,KLst]>0 THEN BEGIN B[I]:=H[I]/X[I,KLst]; P:=B[I];KLstr:=I; END ELSE BEGIN B[I]:=-1; P1:=P1+1; END; END; IF P1=Kstr*K_st THEN BEGIN SAVE(0,'',0); SAVE(0,'rechenii net',3); HALT; END; P1:=0; FOR J:=1 TO Kell DO IF ABS(Mo-Fo[J])<Epsilon THEN FOR I:=1 TO Kstr DO IF B[I]>=0 THEN BEGIN IF B[I]<P THEN IF Bvsp[KLst]<>BS[I] THEN BEGIN P:=B[I]; KLstr:=I; END; IF INT(10000*B[I])=INT(10000*P) THEN IF (BS[I][1]='Y') AND (BS[KLstr][1]='X') THEN IF Bvsp[KLst]<>BS[I] THEN BEGIN P:=B[I]; KLstr:=I; END; END; SAVE(0,'klychevaya stroka ',2);SAVE(KLstr,' ',1); SAVE(0,'',0); FOR I:=1 TO Kstr DO IF Bvsp[KLst]=BS[I] THEN BEGIN SAVE(0,'rechenii net',3); SAVE(0,'takaya peremennaya',3); HALT; END; { Вызов процедуры сокращения Y } IF CPr[KLstr]=1 THEN SOKR; { Построение следующей Симплекс-таблицы } BS[KLstr]:=Bvsp[KLst]; Cnew[KLstr]:=FX[KLst]; CPrnew[KLstr]:=FunctPr[KLst]; FOR I:=1 TO Kstr DO BEGIN IF I=KLstr THEN Hnew[I]:=H[I]/X[KLstr,KLst] ELSE Hnew[I]:=H[I]-(H[KLstr]*X[I,KLst]/X[KLstr,KLst]); FOR J:=1 TO Kell DO BEGIN IF (I=KLstr) AND (J=KLst) THEN Xnew[I,J]:=1; IF (I=KLstr) AND (J<>KLst) THEN Xnew[I,J]:=X[I,J]/X[KLstr,KLst]; IF (I<>KLstr) AND (J=KLst) THEN Xnew[I,J]:=0; IF (I<>KLstr) AND (J<>KLst) THEN Xnew[I,J]:=X[I,J]-(X[KLstr,J]*X[I,KLst]/X[KLstr,KLst]); END; END; KLst:=0;KLstr:=0; Kit:=Kit+1; UNTIL (Kit=0); END; { Основная программа } BEGIN CLRSCR; Kit:=0;Dop_X:=0; ASSIGN(F,'SIMPLEX.DAT'); REWRITE(F); CLOSE(F); ST:; WRITE('vvedite kol vo strok:');READLN(Kstr); IF Kstr>10 THEN BEGIN WRITELN('programma rachitana na vvedennoe kol vo strok !'); GOTO ST; END; ELL: WRITE('vvedite kol vo elementov:');READLN(Kell); IF Kell>10 THEN BEGIN WRITELN('programma ne rachitana na vvedennoe kol vo strok'); GOTO ELL; END; ZN: WRITE('issleduem на max(1) или min(2):');READLN(Fm); IF (Fm<>1) AND (Fm<>2) THEN BEGIN WRITELN('vvedite snova');GOTO ZN; END; WRITE('celochislennoe rechenie(Y/N): ');READLN(PrGomory); IF (PrGomory='Y') OR (PrGomory='y') THEN PrGomory:='Y' ELSE PrGomory:='N'; { Вызов процедуры SIMPLEX} SIMPLEX; END. |
Похожие темы | ||||
Тема | Автор | Раздел | Ответов | Последнее сообщение |
Алгоритм линейного раскроя (финальный рывок) | AXS | Общие вопросы Delphi | 16 | 06.02.2009 16:33 |
Сортировка линейного массива. C++ DOS | Xeon332 | Общие вопросы C/C++ | 2 | 15.12.2008 16:21 |
Сортировка линейного списка. | ТИВ | Паскаль, Turbo Pascal, PascalABC.NET | 3 | 23.11.2008 22:39 |
Алгоритмы линейного и бинарного поиска. | Seafulf | Паскаль, Turbo Pascal, PascalABC.NET | 4 | 01.03.2008 21:39 |