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)] */