You selected lpolp01xy.pl
title:-
A=['%------------------------------------------------------------'
,'% Linear and Quadratic programming on logic programing :'
,'% Simplex algorithm by Danzig augmented with '
,'% Lemke-Howson algorithm for linear complementarity problems.'
,'% By Kenryo INDO (Kanto Gakuen University) '
,'%---------------------------------------------'
,'% main: bimatrix/1,2, simplex/1 '
,'% file: lpolp01x.pl '
,'% created: 29-30 July 2003. (lp0.pl)'
,'% modified: 11-15 Aug 2003.(lpolp0.pl)'
,'% modified: 15-16 Aug 2003.(lpolp01.pl)'
,'% modified: 1 Jul 2004.(lpolp01x.pl)'
,'% modified: 3 Jul 2004.(lpolp01xy.pl)'
], forall(member(L,A),(nl,write(L))),nl.
:-title.
reference:-
A=[
'% reference:',
'% [1] Lemke, C.E. and J.T. Howson (1964). Equilibrium points of bimatrix games. J.of SIAM 12(2): 413-423. ',
'% [2] von Stengel, B. (2002). Computing equilibria for two-person games. In R.J. Aumann and S. Hart(eds.), Handbook of Game Theory, Volume 3, Elsevier, chapter 45. '
], forall(member(L,A),(nl,write(L))).
%--------------------------------------
% Lemke-Howson algorithm ---
%--------------------------------------
update_start(S):-
abolish(start_with/1),
assert(start_with(S)).
:- dynamic start_with/1.
start_with(x2).
%bimatrix_game(matrix_A,matrix_B^t).
bimatrix_game(matrix_AB,matrix_AB).
% main
%--------------------------------------
bimatrix(A):-
bimatrix(A,A).
bimatrix(A,B):-
bimatrix_game(A,B),
preprocess_for_bimatrix(A,B),
bimatrix(A,B,_K).
bimatrix(A,A,K):-
nl,
do_pivot_for_matrix(1,K,A,A),
nl,!,
(stopping_rule_for_bimatrix(K,A,A)
->terminate_process(A,A)
;bimatrix(A,A,_)
),
!.
bimatrix(A,B,K):-
detect_sequence_of_matrix_pair(C,D),
(A\=B->do_pivot_for_matrix(C,K,A,B);true),
nl,
do_pivot_for_matrix(D,K,A,B),
nl,
% nl, write('go ahead ? >'),read(y),
(stopping_rule_for_bimatrix(K,A,B)->!,fail;true),
bimatrix(A,B,_).
bimatrix(A,B,-1):-
terminate_process(A,B),
!.
% preprocess for bimatrix/2
%--------------------------------------
preprocess_for_bimatrix(A,_B):-
\+ clause(tableau(A,_,_),_),
!,
findall(C,tableau(C,label,_),Bset),
nl, write('no such model.'),
nl, write(' please select one from the available models as follows: '),
nl, write(Bset),
fail.
preprocess_for_bimatrix(A,B):-
nl, write('will you initialize privious results ? >'),
read(y),
retractall(tableau(pivot(_,_),_,_)),
initialize_pivot_steps(A),
(A\=B->initialize_pivot_steps(B);true),
set_initial_objectives(A,B),
display_kth_table(A,0),
(A\=B->display_kth_table(B,0);true),
update_bimatrix_log(A,B,start,time(_TS)).
% commplementary pivoting
%--------------------------------------
do_pivot_for_matrix(1,K,A,B):-
nl, write(('do pivot for ',B,' ? (y/n) >')),
do_by_user_confirm(_,then(true),else((!,fail))),
update_tableau(B,step(K),in(MyIN),out(MyOUT)),
nl,write((in(MyIN),out(MyOUT))),
display_kth_table(B,K),
set_opponents_objective(B,A,[K,MyIN,MyOUT,_DualIN]),write([rule:1]).
do_pivot_for_matrix(2,K,A,B):-
nl, write(('do pivot for ',A,' ? (y/n)>')),
do_by_user_confirm(_,then(true),else((!,fail))),
nl,
update_tableau(A,step(K),in(MyIN),out(MyOUT)),
nl,write((in(MyIN),out(MyOUT))),
display_kth_table(A,K),
set_opponents_objective(A,B,[K,MyIN,MyOUT,_DualIN]),write([rule:2]).
set_opponents_objective(MyMatrix,OpponMatrix,[K,MyIN,MyOUT,DualIN]):-
log_of_update_tableau(
MyMatrix,
step((K0->K)),
update_coefficient((MyOUT->MyIN)),
end
),
dual(MyMatrix:MyOUT,OpponMatrix:DualIN), % find the comlementary pair of variables.
detect_next_matrix(K0,K,OpponMatrix,NextStep),
update_objective(NextStep,OpponMatrix,DualIN).
% dual variables dictionary
%-----------------------------------------
dual(matrix_A:r1,matrix_B^t:x1).
dual(matrix_A:r2,matrix_B^t:x2).
dual(matrix_A:r3,matrix_B^t:x3).
dual(matrix_A:y4,matrix_B^t:s4).
dual(matrix_A:y5,matrix_B^t:s5).
dual(X,Y):-clause(dual(Y,X),true).
dual(matrix_AB:r1,matrix_AB:x1).
dual(matrix_AB:r2,matrix_AB:x2).
dual(matrix_AB:r3,matrix_AB:x3).
dual(matrix_AB:y4,matrix_AB:s4).
dual(matrix_AB:y5,matrix_AB:s5).
% sequence of matrix processing
%-----------------------------------------
detect_next_matrix(K0,K,M,N):-
detect_sequence_of_matrix_pair(C,D),
pattern_rule_of_next_matrix(K0,K,M,C,D,N).
detect_sequence_of_matrix_pair(2,1):-
bimatrix_game(M,M),
!.
detect_sequence_of_matrix_pair(C,D):-
start_with(Missing),
dual(A:Missing,B:_Dual),
bimatrix_game(M1,M2),
member((A,B,C,D),[(M1,M2,2,1),(M2,M1,1,2)]).
pattern_rule_of_next_matrix(K0,_K,M,1,2,K0):-bimatrix_game(M,_).
pattern_rule_of_next_matrix(_K0,K,M,1,2,K):-bimatrix_game(_,M).
pattern_rule_of_next_matrix(_K0,K,M,2,1,K):-bimatrix_game(M,_).
pattern_rule_of_next_matrix(K0,_K,M,2,1,K0):-bimatrix_game(_,M).
% setting the objective functions sensitive to the sequence of matrix.
%--------------------------------------
update_objective(N,M,IN):-
T=tableau(pivot(M, step(N)),solved(objective),_),
(clause(T,_)->retract(T);true), %nl,write(T),
set_coefficient_of_objective(M,N,IN,-1,ROW),
nl,write('I have changed the objective row of '),
write(M:step(N)),write(' as '),write(ROW).
% setting the starting missing variable and the initial objective functions.
%--------------------------------------
set_initial_objectives(A,B):-
write('start from: ?-'), read(S),
((dual(A:S,_),
set_coefficient_of_objective(A,0,S,-1,ROW),
(A\=B->update_objective(0,_,B,0);true)
)
;
(dual(_,B:S),
set_coefficient_of_objective(B,0,S,-1,ROW),
(A\=B->set_zeros_of_objective(A,0);true)
)
),
update_start(S).
set_zeros_of_objective(M,K):-
set_coefficient_of_objective(M,K,_ANY,0,_ROW).
set_coefficient_of_objective(M,K,IN,X,ROW):-
T=tableau(pivot(M, step(K)),solved(objective),_),
(clause(T,_)->retract(T);true),
tableau(M, label,ROW1),
replace_elements_if([position:P,list:ROW1,with:X,otherwise:0],P=IN,ROW),
assert(tableau(
pivot(M, step(K)),
solved(objective),
ROW
)).
replace_elements_if([position:P,list:List,with:X,otherwise:O],CONDITION,Y):-
findall(C,
(
member(P,List),
(CONDITION->C=X;C=O)
),
Y).
/*
?- X=a,List=[0,0,1,0,1,0,2,3],
replace_elements_if([position:P,list:List,with:9,otherwise:X],P=0,Y).
X = a
List = [0, 0, 1, 0, 1, 0, 2, 3]
P = _G188
Y = [9, 9, a, 9, a, 9, a, a]
Yes
?-
*/
% stopping rule
%-----------------------------------------
stopping_rule_for_bimatrix(K,A,B):-
start_with(Y),
dual(A:X,B:Y),
stopping_condition(_,[A,K,X,Y],MES),
nl,
write('The condition satisfies: '),
nl,
write(MES),
write((' just has left from the base of ',A,' extended matrix.')).
stopping_condition(0,[A,K,_X,_],'the objective'):-
log_of_update_tableau(
A,
step((objective->K)),
update_coefficient((_->_IN)),
end
).
stopping_condition(1,[A,K,X,Y],('the dual of start',X,of,Y)):-
log_of_update_tableau(
A,
step((_K0->K)),
update_coefficient((X->_IN)),
end
).
% terminating process
%-----------------------------------------
terminate_process(A,B):-
update_bimatrix_log(A,B,end,time(_TF)),
LOG1=tableau(pivot(M,_),_,_),
LOG2=log_of_update_tableau(M,_,_,end),
nl,
write('!!! I can not improve the solution any more. It seems optimal. '),
nl,
write('listing logbook ? >'),
do_by_user_confirm(_,
then(
forall(
(LOG2,sort([A,B],AB),member(M,AB)),
(nl,write(LOG2)))
),
else(true)
),
nl,
write('save results to file? (bimatrix_out.txt) >'),
GL=(member(LOG,[LOG1,LOG2]),LOG),
SAVE=tell_goal('bimatrix_out.txt',forall_such_that,LOG,GL),
do_by_user_confirm(_,then(SAVE),else(true)).
% logbook for the process of bimatrix
%-----------------------------------------
% :- dynamic log_of_update_tableau/4. % common
update_bimatrix_log(A,B,start,time(TS)):-
abolish(log_of_update_tableau/4),
nl,time_stamp('%% bimatrix : start time ',TS),
assert(
log_of_update_tableau([A,B],bimatrix,start,time(TS))
).
update_bimatrix_log(A,B,end,time(TF)):-
nl,time_stamp('%% bimatrix : end time ',TF),
assert(
log_of_update_tableau([A,B],bimatrix,end,time(TF))
).
log_data_of_bimatrix(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|_].
%--------------------------------------
% examples of LP problems
%--------------------------------------
lp(lp1).
lp(lp2).
lp(X):-bimatrix(X,Y),Y \= X.
lp(Y):-bimatrix(Y,X),Y \= X.
lp(Y):-bimatrix(Y,Y).
% the tabular representations
%--------------------------------------
:- dynamic tableau/3.
% a bimatrix game in von Stengel(2002).
tableau(matrix_A,label, [c,f,r1,r2,r3,y4,y5]).
tableau(matrix_A,solved(r1),[1,1, 1, 0, 0, 0, 6]).
tableau(matrix_A,solved(r2),[1,1, 0, 1, 0, 2, 5]).
tableau(matrix_A,solved(r3),[1,1, 0, 0, 1, 3, 3]).
tableau(matrix_A,solved(objective),[0,0,0,0,0,0,0]).
tableau(matrix_B^t,label, [c,e,x1,x2,x3,s4,s5]).
tableau(matrix_B^t,solved(s4),[1,1, 1, 0, 4, 1, 0]).
tableau(matrix_B^t,solved(s5),[1,1, 0, 2, 4, 0, 1]).
tableau(matrix_B^t,solved(objective),[0,0,0,-1,0,0,0]). % only missing label of variable x2.
% The solution (NE of this game) is x=[1,1/2,0], y=[1/6,1/12].
/*
% the final tableau of bimatrix/2
%-------------------------
tableau(pivot(matrix_B^t, step(2)), solved(x1), [1, 1, 1, 0, 4, 1, 0]).
tableau(pivot(matrix_B^t, step(2)), solved(x2), [0.5, 0.5, 0, 1, 2, 0, 0.5]).
tableau(pivot(matrix_A, step(2)), solved(r3), [0.25, 0.25, 0.75, -1.5, 1, 0, 0]).
tableau(pivot(matrix_A, step(2)), solved(y4), [0.0833333, 0.0833333, -0.416667, 0.5, 0, 1, 0]).
tableau(pivot(matrix_A, step(2)), solved(y5), [0.166667, 0.166667, 0.166667, 0, 0, 0, 1]).
log_of_update_tableau(matrix_B^t, step((0->1)), update_coefficient((s5->x2)), end).
log_of_update_tableau(matrix_A, step((0->1)), update_coefficient((r1->y5)), end).
log_of_update_tableau(matrix_B^t, step((1->2)), update_coefficient((s4->x1)), end).
log_of_update_tableau(matrix_A, step((1->2)), update_coefficient((r2->y4)), end).
*/
% alternative bimatrix representation of above example.
tableau(matrix_AB,label, [c,f,x1,x2,x3,s4,s5,r1,r2,r3,y4,y5]).
tableau(matrix_AB,solved(r1),[1,1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 6]).
tableau(matrix_AB,solved(r2),[1,1, 0, 0, 0, 0, 0, 0, 1, 0, 2, 5]).
tableau(matrix_AB,solved(r3),[1,1, 0, 0, 0, 0, 0, 0, 0, 1, 3, 3]).
tableau(matrix_AB,solved(s4),[1,1, 1, 0, 4, 1, 0, 0, 0, 0, 0, 0]).
tableau(matrix_AB,solved(s5),[1,1, 0, 2, 4, 0, 1, 0, 0, 0, 0, 0]).
tableau(matrix_AB,solved(objective),[0,0,0,-1,0,0,0,0,0,0,0,0]).
/*
% the final tableau of bimatrix/2
%-------------------------
tableau(pivot(matrix_AB, step(4)), solved(y4), [0.0833333, 0.0833333, 0, 0, 0, 0, 0, -0.416667, 0.5, 0, 1, 0]).
tableau(pivot(matrix_AB, step(4)), solved(x1), [1, 1, 1, 0, 4, 1, 0, 0, 0, 0, 0, 0]).
tableau(pivot(matrix_AB, step(4)), solved(y5), [0.166667, 0.166667, 0, 0, 0, 0, 0, 0.166667, 0, 0, 0, 1]).
tableau(pivot(matrix_AB, step(4)), solved(x2), [0.5, 0.5, 0, 1, 2, 0, 0.5, 0, 0, 0, 0, 0]).
tableau(pivot(matrix_AB, step(4)), solved(r3), [0.25, 0.25, 0, 0, 0, 0, 0, 0.75, -1.5, 1, 0, 0]).
tableau(pivot(matrix_AB, step(4)), solved(objective), [0, 0, 0, -1, 0, 0, 0, 0, 0, 0, 0, 0]).
log_of_update_tableau(matrix_AB, step((0->1)), update_coefficient((s5->x2)), end).
log_of_update_tableau(matrix_AB, step((1->2)), update_coefficient((r1->y5)), end).
log_of_update_tableau(matrix_AB, step((2->3)), update_coefficient((s4->x1)), end).
log_of_update_tableau(matrix_AB, step((3->4)), update_coefficient((r2->y4)), end).
*/
% easy problem of LP.
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 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)
% 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
).
% 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)).
% a cut ! has added (1 Jun 2004)
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)
,Var_out \= Var_in % <--- added: 1 Jul 2004 (bugfix)
%,Var_out \= objective % <--- optionally added: 1 Jul 2004 (bugfix)
)
),
!.
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),
\+ Coefficent is 0, % <--- added: 1 Jul 2004 (bugfix)
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)):-
T0=tableau(pivot(M,step(K0)),solved(RES),Coe),
T0,
% nl,write(debug(0):T0),
findall(C1,(member(C,Coe),C1 is C/PIVOT),Coe1),
T=tableau(pivot(M,step(K)),solved(ACT),Coe1),
assert(T),
fail.
update_tableau_coefficients(M,step(K0,K),pivot(ACT,RES,_PIVOT)):-
% Self=update_tableau_coefficients(M,step(K0,K),pivot(ACT,RES,_PIVOT)),
% nl,write(Self),
Ta = tableau(pivot(M,step(K)),solved(ACT),PivCoe),
clause(Ta,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
)
).
%--------------------------------------
% a script of simplex algorithm
%--------------------------------------
simplex(M):-
lp(M),
preprocess_for_simplex(M),
simplex(M,_K).
% 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).
% 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))).
% 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.