You selected lpolp01.pl
%----------------------------------------------------
% linear programming on logic programing :
% A solver using simplex algorithm by Danzig.
% By Kenryo INDO (Kanto Gakuen University)
%---------------------------------------------
% file: lpolp01.pl [lupolupo:w^n]
% created: 29-30 July 2003. (lp0.pl)
% modified: 11-15 Aug 2003.(lpolp0.pl)
% modified: 15-16 Aug 2003.(lpolp01.pl)
%--------------------------------------
% examples of LP problems
%--------------------------------------
% use for varification-only.
%--------------------------------------
lp0(Variables,Objective,Constraints):-
Variables = [X,Y],
Objective = 2 * X + Y,
Constraints =
(
X + Y =< 10,
3 * X + 2 * Y =< 15,
2 * X + Y =< 8,
X >= 0,
Y >= 0
).
lp1(Variables,Objective,Constraints):-
Variables = [X,Y],
Objective = 70 * X + 120 * Y,
Constraints =
(
9 * X + 4 * Y =< 1080,
4 * X + 5 * Y =< 600,
3 * X + 10 * Y =< 900,
X >= 0,
Y >= 0
).
% the tabular representations
%--------------------------------------
:- dynamic tableau/3.
% model interpretation:
% lp model : the problem (tableau/3 with a model indicator in the 1st argument)
% activities : the variable (tableau/3 with a lavel in the 2nd argument)
% resources : the constraint (tableau/3 with a solved(_) in the 2nd argument)
tableau(lp1,label,[c,x,y,s1,s2,s3]).
tableau(lp1,solved(s1),[10,1,1,1,0,0]).
tableau(lp1,solved(s2),[15,3,2,0,1,0]).
tableau(lp1,solved(s3),[8,2,1,0,0,1]).
tableau(lp1,solved(objective),[0,-2,-1,0,0,0]).
tableau(lp2,label,[c,x,y,s1,s2,s3]).
tableau(lp2,solved(s1),[1080,9,4,1,0,0]).
tableau(lp2,solved(s2),[600,4,5,0,1,0]).
tableau(lp2,solved(s3),[900,3,10,0,0,1]).
tableau(lp2,solved(objective),[0,-70,-120,0,0,0]).
% a rendering for the matrix
indexed_tableau(M,index(X,Y),Z):-
tableau(M,solved(X),COE),
tableau(M,label,LB),
nth1(K,LB,Y),
nth1(K,COE,Z).
% basis
basis(M,X=V):-
tableau(M,solved(X),[V|_Coefficients]).
% in order for the matrix operations in matrix1b.pl
assert_tableau(LP):-
tableau(LP,label,_),
findall(TR, tableau(LP,solved(_),TR), M),
assert(matrix(LP,M)).
% pivoting for tabular representation
%--------------------------------------
pivot(M,in(Var_in,COBJ),out(Var_out,CPT=W/PIVOT)):-
tableau(M,label,_),
select_pivot(M,activity(Var_in),marginal(COBJ)),
select_pivot(M,resource(Var_out),activity(Var_in),intercept(CPT=W/PIVOT)).
select_pivot(M,activity(Var_in),marginal(Negative)):-
max(C_abs,
(
negative_marginal_price(M,activity,Var_in,Negative),
abs(Negative,C_abs)
)
).
select_pivot(M, resource(Var_out),activity(Var_in),
intercept(CPT=Constant / Coefficent)
):-
max(-CPT,
non_negative_intercept(M,resource,Var_in,Var_out,CPT=Constant / Coefficent)
).
negative_marginal_price(M,activity,Var_in,Negative):-
indexed_tableau(M,index(objective,Var_in),Negative),
Negative < 0.
non_negative_intercept(M,resource,Var_in,Var_out,CPT=Constant / Coefficent):-
tableau(M,solved(Var_out),[Constant|_]),
indexed_tableau(M,index(Var_out,Var_in),Coefficent),
CPT is Constant / Coefficent,
%nl,write(non_negative_intercept),
%nl,write((M,resource,Var_in,Var_out,CPT=Constant / Coefficent)),
CPT > 0.
% update each tableau using pivot/3 and update_tableau_coefficients/4.
%-----------------------------------------
update_tableau(M,step(K),in(ACT),out(RES)):-
retract(tableau(M,current_pivot_step,K0)),
K is K0 + 1,
assert(tableau(M,current_pivot_step,K)),
pivot(pivot(M,step(K0)),in(ACT,_),out(RES,_=_/PIVOT)),
update_tableau_coefficients(M,step(K0,K),pivot(ACT,RES,PIVOT)).
% new coefficient vector for each tableau pivoted
%-------------------------------------------------
update_tableau_coefficients(M,step(K0,K),pivot(ACT,RES,_PIVOT)):-
assert(
log_of_update_tableau(M,step(K0->K),update_coefficient(RES->ACT), start)
),
fail.
update_tableau_coefficients(M,step(K0,K),pivot(ACT,RES,PIVOT)):-
tableau(pivot(M,step(K0)),solved(RES),Coe),
findall(C1,(member(C,Coe),C1 is C/PIVOT),Coe1),
assert(tableau(pivot(M,step(K)),solved(ACT),Coe1)),
fail.
update_tableau_coefficients(M,step(K0,K),pivot(ACT,RES,_PIVOT)):-
clause(tableau(pivot(M,step(K)),solved(ACT),PivCoe),true),
tableau(pivot(M,step(K0)),solved(Var),Coe),
Var \= RES,
indexed_tableau(pivot(M,step(K0)),index(Var,ACT),Multiplier),
findall(C1,
(
nth1(J,Coe,C),
nth1(J,PivCoe,PivC),
C1 is C-Multiplier*PivC
),
Coe1),
assert(tableau(pivot(M,step(K)),solved(Var),Coe1)),
fail.
update_tableau_coefficients(M,step(K0,K),pivot(ACT,RES,_PIVOT)):-
assert(
log_of_update_tableau(M,step(K0->K),update_coefficient(RES->ACT),end)
).
%--------------------------------------
% simplex algorithm --- the main
%--------------------------------------
simplex(M):-
preprocess_for_simplex(M),
simplex(M,_K).
% preprocess for pivot tableau
%-----------------------------------------
preprocess_for_simplex(M):-
\+ clause(tableau(M,_,_),_),
!,
findall(B,tableau(B,label,_),Bset),
nl, write('no such model. please select one from the available models as follows: '),
nl, write(Bset),
fail.
preprocess_for_simplex(M):-
nl, write('will you initialize privious results ? >'),
read(y),
initialize_pivot_steps(M),
display_kth_table(M,0),
fail.
preprocess_for_simplex(M):-
% start logbook
% --- which must be done before begin of (iterative) simplex/2.
update_simplex_log(M,start,time(_TS)).
display_kth_table(M,K):-
G1 = tableau(pivot(M,step(K)),_,_),
forall(clause(G1,true), (nl,write(G1))).
% start of pivot and do it iteratively.
%-----------------------------------------
simplex(M,K):-
nl, write('go ahead ? >'),
do_by_user_confirm(_,then(true),else(simplex(M,-1))),
update_tableau(M,step(K),_IN,_OUT),
display_kth_table(M,K),
\+ stopping_rule(max_objective,M,K,_),
simplex(M,_).
simplex(M,-1):-
end_logbook_and_terminate_process(M).
% stopping criteria.
%-----------------------------------------
stopping_rule(max_objective,M,K,case(1)):-
tableau(M,current_pivot_step,K),
tableau(pivot(M,step(K)),solved(objective),[_OBJ|COE]),
\+ (member(C,COE), C < 0).
% use below to stop the process pivot if degenerate.
/*
stopping_rule(max_objective,M,K,case(2)):-
tableau(M,current_pivot_step,K),
K0 is K - 1,
tableau(pivot(M,step(K0)),solved(objective),[OBJ_0|_]),
tableau(pivot(M,step(K)),solved(objective),[OBJ_1|_]),
OBJ_1 =< OBJ_0.
*/
% initialize before start of pivot
%-----------------------------------------
initialize_pivot_steps(M):-
retractall(tableau(pivot(M,_),_,_)),
retractall(tableau(M,current_pivot_step,_)),
assert(tableau(M,current_pivot_step,0)),
tableau(M,label,Labels),
assert(tableau(pivot(M,_Any),label,Labels)),
forall(
tableau(M,solved(Var),Coefficients),
assert(tableau(pivot(M,step(0)),solved(Var),Coefficients))
).
% logbook for the process of simplex
%-----------------------------------------
:- dynamic log_of_update_tableau/4.
update_simplex_log(M,start,time(TS)):-
abolish(log_of_update_tableau/4),
nl,time_stamp('%% simplex : start time ',TS),
assert(
log_of_update_tableau(M,simplex,start,time(TS))
).
update_simplex_log(M,end,time(TF)):-
nl,time_stamp('%% simplex : end time ',TF),
assert(
log_of_update_tableau(M,simplex,end,time(TF))
).
% terminating process
%-----------------------------------------
end_logbook_and_terminate_process(M):-
update_simplex_log(M,end,time(_TF)),
LOG1=tableau(pivot(M,_),_,_),
LOG2=log_of_update_tableau(M,_,_,_),
nl,
write('!!! I can not improve the solution any more. It seems optimal. '),
%nl,
%write('listing tableau ? >'),
%do_by_user_confirm(_,then(listing(LOG1)),else(true)),
nl,
write('listing logbook ? >'),
do_by_user_confirm(_,then(listing(LOG2)),else(true)),
nl,
write('save results to file? (simplex_out.txt) >'),
GL=(member(LOG,[LOG1,LOG2]),LOG),
SAVE=tell_goal('simplex_out.txt',forall_such_that,LOG,GL),
do_by_user_confirm(_,then(SAVE),else(true)).
log_data_of_simplex(TYPE,LOG):-
member(TYPE,[tableau,log_of_update_tableau]),
LOG1 = tableau(pivot(M,_),_,_),
LOG2 = log_of_update_tableau(M,_,_,_),
member(LOG,[LOG1,LOG2]),
LOG,
LOG=..[TYPE|_].
%-----------------------------------------
% utilities
%-----------------------------------------
do_by_user_confirm(if(USER),then(ACT1),else(ACT2)):-
(var(USER)->read(USER);true),
(
member(USER,
[y,'Y',yes,'Yes','YES',ok,'OK',go]
)
-> ACT1 ; ACT2
).
max(X,Goal):-
% X: the objective variable,
% Goal: the objective function and constraints,
setof((X,Goal),Goal,Z),
member((X,Goal),Z),
\+ (
member((Y,_),Z),
Y > X
).
% redirect to file
%--------------------------------
tell_goal(File,G):-
(current_stream(File,write,S0)->close(S0);true),
open(File,write,S),
tell(File),
nl,
time_stamp('% file output start time ',_),
nl,
write('%---------- start from here ------------%'),
nl,
G,
nl,
write('%---------- end of data ------------%'),
nl,
time_stamp('% file output end time ',_),
tell(user),
close(S),
% The following is to cope with the duplicated stream problem.
(current_stream(File,write,S1)->close(S1);true).
% 成功するゴールをすべて保存
%--------------------------------
tell_goal(File,forall,G):-
G0 = (nl,write(G),write('.')),
G1 = forall(G,G0),
tell_goal(File,G1).
tell_goal(File,forall_such_that,G,Condition):-
% G should be occurred in the Condition.
WRITE = (nl,write(G),write('.')),
G1 = forall(Condition,WRITE),
tell_goal(File,G1).
% time stamp
%--------------------------------
time_stamp(no,T):-
get_time(U),
convert_time(U,A,B,C,D,E,F,_G),
T = [date(A/B/C), time(D:E:F)],
nl.
time_stamp(Word,T):-
\+ var(Word),
Word \= no,
get_time(U),
convert_time(U,A,B,C,D,E,F,_G),
T = [date(A/B/C), time(D:E:F)],
% format('~`.t~t~a~30|~`.t~t~70|~n',[Word]),
write((Word,T)),
nl.
% save current user model to file
% ----------------------------------------------------------- %
tell_all_pred:-
Q=user_defined_predicate(P,Info),
G1=findall((P,Info),Q,D),
G2=forall(
(
member((P,Info),D)
),
(
P=..[X|Z],
%current_functor(X,Y)
length(Z,L),
write(X),write(' / '),
write(L),tab(2),write(Info),nl
)
),
G=(G1,G2),
tell_goal('all_pred.txt',G).
user_defined_predicate(P,[file(F),lines(L),clauses(N)]):-
predicate_property(P,line_count(L)),
predicate_property(P,number_of_clauses(N)),
predicate_property(P,file(F)),
\+ predicate_property(P,imported_from(system)),
\+ predicate_property(P,built_in).
%*******************************************************************
% Appendix 1. A test run
%*******************************************************************
/*
?- [lpolp01].
% lpolp01 compiled 0.34 sec, -1,804 bytes
Yes
?- simplex(lp2).
will you initialize privious results ? >y.
tableau(pivot(lp2, step(0)), label, [c, x, y, s1, s2, s3])
tableau(pivot(lp2, step(0)), solved(s1), [1080, 9, 4, 1, 0, 0])
tableau(pivot(lp2, step(0)), solved(s2), [600, 4, 5, 0, 1, 0])
tableau(pivot(lp2, step(0)), solved(s3), [900, 3, 10, 0, 0, 1])
tableau(pivot(lp2, step(0)), solved(objective), [0, -70, -120, 0, 0, 0])
%% simplex : start time , [date(2003/8/16), time(19:10:47)]
go ahead ? >y.
tableau(pivot(lp2, step(1)), label, [c, x, y, s1, s2, s3])
tableau(pivot(lp2, step(1)), solved(y), [90, 0.3, 1, 0, 0, 0.1])
tableau(pivot(lp2, step(1)), solved(s1), [720, 7.8, 0, 1, 0, -0.4])
tableau(pivot(lp2, step(1)), solved(s2), [150, 2.5, 0, 0, 1, -0.5])
tableau(pivot(lp2, step(1)), solved(objective), [10800, -34, 0, 0, 0, 12])
go ahead ? >y.
tableau(pivot(lp2, step(2)), label, [c, x, y, s1, s2, s3])
tableau(pivot(lp2, step(2)), solved(x), [60, 1, 0, 0, 0.4, -0.2])
tableau(pivot(lp2, step(2)), solved(y), [72, 0, 1, 0, -0.12, 0.16])
tableau(pivot(lp2, step(2)), solved(s1), [252, 0, 0, 1, -3.12, 1.16])
tableau(pivot(lp2, step(2)), solved(objective), [12840, 0, 0, 0, 13.6, 5.2])
%% simplex : end time , [date(2003/8/16), time(19:10:48)]
!!! I can not improve the solution any more. It seems optimal.
listing logbook ? >y.
log_of_update_tableau(lp2, simplex, start, time([date(2003/8/16), time(19:10:47)])).
log_of_update_tableau(lp2, step((0->1)), update_coefficient((s3->y)), start).
log_of_update_tableau(lp2, step((0->1)), update_coefficient((s3->y)), end).
log_of_update_tableau(lp2, step((1->2)), update_coefficient((s2->x)), start).
log_of_update_tableau(lp2, step((1->2)), update_coefficient((s2->x)), end).
log_of_update_tableau(lp2, simplex, end, time([date(2003/8/16), time(19:10:48)])).
save results to file? (simplex_out.txt) >y.
Yes
?-
*/
%*******************************************************************
% Appendix 2. the saved results in simplex_out.txt below
%*******************************************************************
/*
% file output start time , [date(2003/8/16), time(19:12:30)]
%---------- start from here ------------%
tableau(pivot(lp2, _G639), label, [c, x, y, s1, s2, s3]).
tableau(pivot(lp2, step(0)), solved(s1), [1080, 9, 4, 1, 0, 0]).
tableau(pivot(lp2, step(0)), solved(s2), [600, 4, 5, 0, 1, 0]).
tableau(pivot(lp2, step(0)), solved(s3), [900, 3, 10, 0, 0, 1]).
tableau(pivot(lp2, step(0)), solved(objective), [0, -70, -120, 0, 0, 0]).
tableau(pivot(lp2, step(1)), solved(y), [90, 0.3, 1, 0, 0, 0.1]).
tableau(pivot(lp2, step(1)), solved(s1), [720, 7.8, 0, 1, 0, -0.4]).
tableau(pivot(lp2, step(1)), solved(s2), [150, 2.5, 0, 0, 1, -0.5]).
tableau(pivot(lp2, step(1)), solved(objective), [10800, -34, 0, 0, 0, 12]).
tableau(pivot(lp2, step(2)), solved(x), [60, 1, 0, 0, 0.4, -0.2]).
tableau(pivot(lp2, step(2)), solved(y), [72, 0, 1, 0, -0.12, 0.16]).
tableau(pivot(lp2, step(2)), solved(s1), [252, 0, 0, 1, -3.12, 1.16]).
tableau(pivot(lp2, step(2)), solved(objective), [12840, 0, 0, 0, 13.6, 5.2]).
log_of_update_tableau(lp2, simplex, start, time([date(2003/8/16), time(19:10:47)])).
log_of_update_tableau(lp2, step((0->1)), update_coefficient((s3->y)), start).
log_of_update_tableau(lp2, step((0->1)), update_coefficient((s3->y)), end).
log_of_update_tableau(lp2, step((1->2)), update_coefficient((s2->x)), start).
log_of_update_tableau(lp2, step((1->2)), update_coefficient((s2->x)), end).
log_of_update_tableau(lp2, simplex, end, time([date(2003/8/16), time(19:10:48)])).
%---------- end of data ------------%
% file output end time , [date(2003/8/16), time(19:12:30)]
*/
%*******************************************************************
% Appendix 3. all predicate in the model (using tell_all_pred/0)
%*******************************************************************
/*
% file output start time , [date(2003/8/16), time(19:14:41)]
%---------- start from here ------------%
% lp problem
lp0 / 3 [file(lpolp01.pl), lines(20), clauses(1)]
lp1 / 3 [file(lpolp01.pl), lines(32), clauses(1)]
% table representation
tableau / 3 [file(lpolp01.pl), lines(55), clauses(10)]
indexed_tableau / 3 [file(lpolp01.pl), lines(70), clauses(1)]
basis / 2 [file(lpolp01.pl), lines(77), clauses(1)]
assert_tableau / 1 [file(lpolp01.pl), lines(81), clauses(1)]
% pivot
pivot / 3 [file(lpolp01.pl), lines(90), clauses(1)]
select_pivot / 3 [file(lpolp01.pl), lines(95), clauses(1)]
non_negative_intercept / 5 [file(lpolp01.pl), lines(114), clauses(1)]
select_pivot / 4 [file(lpolp01.pl), lines(103), clauses(1)]
negative_marginal_price / 4 [file(lpolp01.pl), lines(110), clauses(1)]
% simplex
simplex / 1 [file(lpolp01.pl), lines(127), clauses(1)]
simplex / 2 [file(lpolp01.pl), lines(161), clauses(2)]
preprocess_for_simplex / 1 [file(lpolp01.pl), lines(134), clauses(3)]
initialize_pivot_steps / 1 [file(lpolp01.pl), lines(186), clauses(1)]
update_tableau / 4 [file(lpolp01.pl), lines(218), clauses(1)]
update_tableau_coefficients / 3 [file(lpolp01.pl), lines(229), clauses(4)]
stopping_rule / 4 [file(lpolp01.pl), lines(172), clauses(2)]
% logbook
update_simplex_log / 3 [file(lpolp01.pl), lines(202), clauses(2)]
log_data_of_simplex / 2 [file(lpolp01.pl), lines(283), clauses(1)]
display_kth_table / 2 [file(lpolp01.pl), lines(154), clauses(1)]
end_logbook_and_terminate_process / 1 [file(lpolp01.pl), lines(264), clauses(1)]
% utilities
do_by_user_confirm / 3 [file(lpolp01.pl), lines(296), clauses(1)]
max / 2 [file(lpolp01.pl), lines(305), clauses(1)]
tell_goal / 4 [file(lpolp01.pl), lines(349), clauses(1)]
tell_goal / 3 [file(lpolp01.pl), lines(343), clauses(1)]
tell_goal / 2 [file(lpolp01.pl), lines(321), clauses(1)]
tell_all_pred / 0 [file(lpolp01.pl), lines(379), clauses(1)]
user_defined_predicate / 2 [file(lpolp01.pl), lines(398), clauses(1)]
time_stamp / 2 [file(lpolp01.pl), lines(359), clauses(2)]
%---------- end of data ------------%
% file output end time , [date(2003/8/16), time(19:14:41)]
*/
return to front page.