You selected pjtsea.pl
headline:-
write('% -------------------------------------------------- %'),nl,
write('% a search probelm : optiml order of information. %'),nl,
write('% -------------------------------------------------- %'),nl,
h0.
h0:-
references,
write('% example 1: search of research and development.'),nl,
write('% expected_value_of(node((A->B)),E,V)'),nl,
write('% evaluate search order of two projects.'),nl,
write('% roll_back([(A->B)|X],H,[E|F]), V is E.'),nl,
write('% evaluate optimal search order.'),nl,
write('% example 2: Pandora problem.'),nl,
write('% sfp(pandora,L,Y,A,S,M,Cq,Eq,V). '),nl,
write('% h0. this.'),nl,
write('% and '),nl,
write('% h1 or sfp. this, but especially for sfp.'),nl.
h1:-
write('% sfp(R,L,Y,A,S,M,Cq,Eq,V). '),nl,
write('% R= pandora, a decision Rule.'),nl,
write('% L : List of projects for search.'),nl,
write('% Y: Total time of search,'),nl,
write('% A: history of Accept or not,'),nl,
write('% S: Seqence of sampled projects,'),nl,
write('% M: Memory of sampled values,'),nl,
write('% Cq: Sequence of cumulative sampling costs,'),nl,
write('% Eq: Expected values of realized projects,'),nl,
write('% V: Values of numerical evaluation of current decision.'),nl.
sfp:-
h1.
me:-
write('% file: pjtsea.pl.'),nl,
write('% created: 12-25 Feb 2003.'),nl,
write('% author: Kenryo INDO (Kanto Gakuen University) '),nl,
write('% url: http://www.us.kanto-gakuen.ac.jp/indo/front.html'),nl.
references:-
write('% reference: Weizman, M. L. (1979). '),nl,
write('% Optimal search fot the best alternative.'),nl,
write('% Econometrica 47(3): 641-654.'),nl,
nl.
:- headline.
/*
Table 1 of Weitzman(1979)
=============================================
Project alpha omega
Cost 15 20
Duration 1 2
Reward 100 55 240 0
Probability .5 .5 .2 .8
---------------------------------------------
expected values
=============================================
single project
alpha 55.5
omega 19.7
sequence of projects
alpha --> omega 55.9
omega --> alpha 56.3
---------------------------------------------
*/
%---------------------------------------------
% example of R & D projects (Weitzman,1979)
%---------------------------------------------
% What is a project here?
% With its initial cost (investment), a research & development project
% reveals, after some duration, the true value of implementation
% when you decide to do it without additional cost.
project(alpha,
cost(15),
duration(1),
reward([100,55]),
probability([0.5,0.5])
).
project(omega,
cost(20),
duration(2),
reward([240,0]),
probability([0.2,0.8])
).
%
% late execution
%---------------------------------------------
project(late(T,X),
cost(C),duration(D),reward(Us),probability(Ps)):-
\+ var(T),
project(X,
cost(C),
duration(D1),
reward(Us),
probability(Ps)
),
D is D1 + T.
%
% resolved project as for its uncertainty
%---------------------------------------------
project(resolved(X,K,P,U),
cost(C),duration(D),reward(Us),probability(Pk)):-
project(X,
cost(C),
duration(D),
reward(Us),
probability(Ps)
),
(degenerate(Ps) -> !, fail ; true),
nth1(K,Us,U),
nth1(K,Ps,P),
characteristic_vector(K,P,Ps,Pk).
% note: We may think a project as a unit act with uncertainty.
% if you want to model more complicated one, so as with the cash flow,
% then it may be useful to build a decision tree of compound projects.
% cf., see decsion tree representation of sequential choice problem
% and its application to the search for projects.
%
% contingency project (i.e., with an option )
%---------------------------------------------------------------
% which is conditional on the realization of another project's
% value with the cost so as to get a guaranteed lower bound
% by the late execution of the preceeding project.
project(option((X/A)),
cost(C),duration(D),reward(U),probability(P)):-
order_of_projects((Y->X)),
project(X,
cost(C1),
duration(D1),
reward(U1),
probability(P)
),
A = resolved(Y,_,_,UA),
project(A,
cost(C0),
duration(D0),
reward(_U0),
probability(_P0)
),
D is D0 + D1,
npv(C1,D0,C1E,_),
C = C0 + C1E,
findall(U2,
(
member(Uk,U1),
max_of(U2,[Uk,UA])
),
U).
/*
%
% summarized information of project
%------------------------------------------
info_project(X,[C,Y,U,P]):-
clause(project(X,A1,A2,A3,A4),true),
A1=cost(C),
A2=duration(Y),
A3=reward(U),
A4=probability(P).
info_project(X,G,V):-
clause(project(X,A1,A2,A3,A4),true),
member(G0,[A1,A2,A3,A4]),
G0=..[G,V].
info_project(X,expv,V):-
expected_value_of_project(X,_EqV,V).
*/
% ----------------------------------------------------------- %
% a Pandora's Problem (Weitzman,1979)
% ----------------------------------------------------------- %
% added: 24 Feb 2003.
% Same as the R&D example, this search problem also is a sequential,
% for n closed box indexed by K, K=1, ..., n,
% where each of box contains a potential reward of Xk = x(K)
% according to independent p.d.f. f(K,X).
% (Therefore no model of adaptive learning about correlated pdfs.)
% It costs c(K) to open box K and
% the uncertainty is resolved after a time lag (= development
% duration in the example of R&D projects) of t(K).
% And we say it is `sequential' because it is not allowed for
% parallel or pay-as-you-go research with the option
% of withdraw if prospects start looking unfavorable.
% a Pandora's search without discount
project(box(1),
cost(15),
duration(1),
reward([55,0]),
probability([0.5,0.5])
).
project(box(2),
cost(20),
duration(2),
reward([240,0]),
probability([0.2,0.8])
).
project(box(3),
cost(30),
duration(1),
reward([100,0]),
probability([0.5,0.5])
).
project(box(4),
cost(15),
duration(4),
reward([140,0]),
probability([0.3,0.7])
).
project(box(5),
cost(5),
duration(3),
reward([500,0]),
probability([0.1,0.9])
).
%--------------------------------------------------------
% a simulator of search with optional decision rule.
%--------------------------------------------------------
sfp(DR,L,Y,A,S,M,Csq,E,V):-
search_for_projects(DR,L,Y,A,S,M,Csq,E,V).
% DR: Decision rule, the 1st argument of accept_or_not /7, for search.
% L : List of projects for search.
% Y: Total time of search,
% A: history of Accept or not,
% S: Seqence of sampled projects,
% M: Memory of sampled values,
% Csq: Sequence of cumulative sampling costs,
% Esq: Expected values of realized projects,
% V: Values of numerical evaluation of current decision.
search_for_projects(Rule,L,0,[],[],[],[],[],0):-
(\+ var(Rule) -> true; Rule = default),
(\+ var(L) -> true; L = [box(1),box(2),box(3)]).
search_for_projects(Rule,L,Y,[F|F1],[X|H],[W|Z],[Cq|Cr],[Eq|Er],V):-
search_for_projects(Rule,L,Y1,F1,H,Z,Cr,Er,_),
(
subtract(L,H,[])-> !,fail; true
),
W = (Y,K,U,P), % series of realization.
Pjt = project(resolved(X,K,P,U),
cost(C),duration(D),reward(_Us),probability(_Pk)),
sampling(Rule,L,H,Pjt),
Y is Y1 + D,
total_sampling_cost(Rule,Cq,Cr,Y,C),
evaluate_project(Rule,Eq,U,Y),
accept_or_not(Rule,L,Y,[F1,[X|H],[Eq|Er]],[F,_KF,Ep]),
V is Ep - Cq.
total_sampling_cost(_,C,[],_Y,C).
total_sampling_cost(default,Cq,Cr,Y,C):-
Cr = [Cq1|_],
interest_rate(R),
discount_factor(R,Y,DF,_),
(Cq1 = 0
-> Cq = C
; Cq = Cq1 + DF * C
).
total_sampling_cost(pandora,Cq,Cr,_Y,C):-
Cr = [Cq1|_],
(Cq1 = 0
-> Cq = C
; Cq = Cq1 + C
).
evaluate_project(default,Eq,UF,Y):-
interest_rate(R),
discount_factor(R,Y,DF,_),
Eq = DF * UF.
evaluate_project(pandora,UF,UF,_Y).
%--------------------------------------------------------
% decision rules for search
%--------------------------------------------------------
% optimal policy for Pandora
% --- the case of 0/R binary & no discount
%------------------------------------------------------------
% If every box is binary lottery with worst reward r(K)=0 and
% with a positive possible sucess reward r(K)>0, then
% the following decision rule is an optimal for this type of
% problem where you must update reservation price for each box.
% RESERVATION PRICE
%--------------------
% z(K) = (p(K)* r(K)-c(K))/p(K).
% SELECTION RULE
%--------------------
% Find an unopened box with highest reservation price.
% Let this value max_rp.
% STOPPING RULE
%--------------------
% Let the max of known (i.e., sampled) rewards max_sampled.
% If max_rp < max_sampled then accept it.
%
% sampling policies
%--------------------------------------------------------
sampling(default,L,H,Pjt):-
Pjt = project(resolved(X,_K,_P,_U),_,_,_,_),
member(X,L),
\+ member(X,H),
Pjt.
sampling(pandora,L,H,Pjt):-
\+ var(L),
\+ var(H),
X = box(_),
Pjt = project(resolved(X,_K,_P,_U),_,_,_,_),
max_rp(pandora,L,H,X,_Mrp,_V),
member(X,L),
\+ member(X,H),
Pjt.
%
% stopping rules
%--------------------------------------------------------
accept_or_not(default,_L,_Y,[F1,H,Z],[F,KF,Ep]):-
(
(member(FP,F1), FP \= non) % if already accepted.
-> (nth1(1,F1,F), KF = 1)
; (nth1(KF,[non|H],F))
),
nth1(KF,Z,Ep).
accept_or_not(pandora,L,_Y,[F1,H,Z],[F,KF,Ep]):-
(
(member(FP,F1), FP \= non) % if already accepted.
-> (nth1(1,F1,F), KF = 1)
; (
max_rp(pandora,L,H,_F2,Mrp,_V),
%nl,write(max_rp(pandora,L,H,_F2,Mrp,_V)),
max_sampled(F0,Max,H,Z),
%nl,write(max_sampled(F0,Max,H,Z)),
(Mrp < Max -> F = F0; F = non),
nth1(KF,[non|H],F)
)
),
nth1(KF,Z,Ep).
%
% reservation price
%--------------------------------------------------------
% dummy rp
rp(pandora,box(K),RP,V):-
project(box(K),
cost(C),
duration(_D),
reward([R,0]),
probability([P,_])
),
RP = (P * R - C)/P,
V is RP.
% maximum reservation price of unsampled boxes.
%--------------------------------------------------------
max_rp(pandora,L,H,B,Mrp,V):-
\+ var(L),
\+ var(H),
member(B,L),
\+ member(B,H),
rp(pandora,B,Mrp,V),
\+ (
member(B1,L),
\+ member(B1,H),
rp(pandora,B1,Mrp1,_),
Mrp1 > Mrp
).
% maximum of value of sampled boxes.
%--------------------------------------------------------
max_sampled(F,Max,H,Z):-
max_of(Max,Z),
nth1(K,Z,Max),
nth1(K,H,F).
%---------------------------------------------
% expected values
%---------------------------------------------
%
% expected value of a project
%---------------------------------------------
expected_value_of(project(X),EqV,V):-
project(X,
cost(C),
duration(Y),
reward(U),
probability(P)
),
p_expected_value_eq(P,U,_E,Eq0),
interest_rate(R),
discount_factor(R,Y,DF,_),
EqV = - C + DF * Eq0,
V is EqV.
%
% recursive expected values in decision tree
%---------------------------------------------
expected_value_of(node(N),E,V):-
decision_tree(node(N),payoff(E)),
V is E.
expected_value_of(node(N),Eq,V):-
decision_tree(node(N),_,_,_),
expected_value_of_0(node(N),Eq,V).
expected_value_of_0(node(N),Eq,V):-
decision_tree(node(N),parent(_),choice(C),delay(_F)),
optimal_choice(C,_Y,Eq,V),
!.
expected_value_of_0(node(N),Eq,V):-
decision_tree(node(N),parent(_),chance(X),prob(P)),
findall(U1,
(
member(B,X),
expected_value_of(B,U1,_)
),
U),
p_expected_value_eq(P,U,_,Eq0),
npv_of_node(N,_A,Eq0,Eq),
V is Eq.
%
%---------------------------------------------------
% net present value (NPV)
%---------------------------------------------------
%
% time preference: discount factor
%---------------------------------------------
interest_rate(1.1).
discount_factor(_,0,1,1).
discount_factor(R,Y,DF,DFV):-
\+ Y is 0,
DF = R ^ (-Y),
DFV is DF.
npv(A,Y,Eq,V):-
interest_rate(R),
discount_factor(R,Y,DF,_),
(Y = 0 -> Eq = A; Eq = DF * A),
V is Eq.
npv_of_node(N,A,Eq0,Eq):-
(
decision_tree(node(N),parent(A),_,_);
decision_tree(node(N),payoff(Eq0))
),
(
decision_tree(node(A),parent(_),choice(C),delay(F))
->
(
nth1(K,C,node(N)),
nth1(K,F,Y),
npv(Eq0,Y,Eq,_V)
)
; Eq = Eq0
).
%
%---------------------------------------------
% choice problem (of project and so on)
%---------------------------------------------
do_or_not(X):-
do_or_not(X,_EqV,_V).
do_or_not(X,EqV,V):-
expected_value_of(X,EqV,V),
V > 0.
optimal_choice(Y,X):-
optimal_choice(Y,X,_EqV,_V).
optimal_choice([X],X,EqV,V):-
expected_value_of(X,EqV,V).
optimal_choice([X|Y],Z,Eq,V):-
optimal_choice(Y,Z1),
expected_value_of(Z1,Eq1,_V1),
expected_value_of(X,EqX,Vx),
V is max(EqX, Eq1),
(Vx >= V -> Z = X; Z = Z1),
(Vx >= V -> Eq = EqX; Eq = Eq1).
%
%---------------------------------------------
% optimal path of decision tree : a roll back
%---------------------------------------------
roll_back([N],[terminal],[X]):-
decision_tree(node(N),payoff(X)).
roll_back([N|[Y|H]],[choice|W],[EV|Q]):-
decision_tree(node(N),parent(_),choice(X),delay(_F)),
optimal_choice(X,node(Y),EV,_V),
roll_back([Y|H],W,Q).
roll_back([N|[Y|H]],[chance|W],[PY*EV|Q]):-
decision_tree(node(N),parent(_),chance(X),prob(P)),
nth1(K,X,node(Y)),
nth1(K,P,PY),
expected_value_of(node(Y),EV,_V),
roll_back([Y|H],W,Q).
is_an_optimal_path([N|H],W,Q):-
decision_tree(node(N),parent(null),_),
roll_back([N|H],W,Q).
%
%-----------------------------------------------------
% decision tree representation of sequential choice
%-----------------------------------------------------
% an example of decision tree
%-----------------------------------------------------
/*
decision_tree(node(r),parent(null),choice([node(a),node(b)]),delay([0,0])).
decision_tree(node(a),parent(r),chance([node(c),node(d)]),prob([0.5,0.5])).
decision_tree(node(b),parent(r),choice([node(e),node(f)]),delay([0,1])).
decision_tree(node(f),parent(b),chance([node(c),node(e)]),prob([0.2,0.8])).
decision_tree(node(c),payoff(10)).
decision_tree(node(d),payoff(0)).
decision_tree(node(e),payoff(4)).
*/
figure(1):-
write('% r a 0.5 '),nl,
write('% -------[ ]--------------( )--------* c(10) '),nl,
write('% | | '),nl,
write('% | 0.5| '),nl,
write('% b| e * d(0) '),nl,
write('% [ ]------* e(4) '),nl,
write('% | '),nl,
write('% f| 0.2 '),nl,
write('% ( )------* c(10) '),nl,
write('% | '),nl,
write('% 0.8| '),nl,
write('% * e(4) '),nl,
write('%'),nl,
write('% Figure 1. a decision tree.'),nl.
% first order construction for the project selection problem.
%------------------------------------------------------------
% The next code is misleading because of that a project should be
% represented as a decision tree at first.
/*
decision_tree(node(r),parent(null),choice([node(alpha),node(omega)],[0,0])).
decision_tree(node(X),payoff(Eq)):-
member(X,[alpha,omega]),
expected_value_of(project(X),Eq,_V).
*/
figure(2):-
write('% alpha 0.57 '),nl,
write('% -------( )---------* 55 '),nl,
write('% | '),nl,
write('% 0.5| '),nl,
write('% | '),nl,
write('% * '),nl,
write('% 100 '),nl,
nl,
write('% omega 0.8 '),nl,
write('% -------( )---------* 0 '),nl,
write('% | '),nl,
write('% 0.2| '),nl,
write('% | '),nl,
write('% * '),nl,
write('% 240 '),nl,
nl,
write('% Figure 2. decision trees for the two projects. '),nl.
% another, rather messy, construction via recursive EV.
%------------------------------------------------------------
/*
decision_tree(node(r),parent(null),choice([node(alpha),node(omega)],[0,0])).
decision_tree(node((X,K,P,U)),payoff(Eq)):-
expected_value_of(project(resolved(X,K,P,U)),Eq,_V).
decision_tree(node(X),parent(r),chance(Y),prob(P)):-
project(X,cost(_C),duration(_D),reward(_U),probability(P)),
\+ X =.. [resolved|_],
findall(node((X,K,P1,U1)),
(
decision_tree(node((X,K,P1,U1)),payoff(_Eq))
),
Y).
*/
/*
If invest the project (R&D) alpha at first, then we can
postpone the execution of it and can keep it as an option until
the uncertainty of the second project omega is resolved.
*/
figure(3):-
write('% alpha 0.5 omega 0.8 do alpha '),nl,
write('% -------( )-------[ ]-------( )------[ ]---------* 55 '),nl,
write('% | (55)| | | '),nl,
write('% 0.5| | 0.2| | '),nl,
write('% | * * * '),nl,
write('% | 55 240 0 '),nl,
write('% | '),nl,
write('% | omega 0.8 do alpha '),nl,
write('% (100)[ ]-------( )-------[ ]---------* 100 '),nl,
write('% do | | | '),nl,
write('% alpha| 0.2| | '),nl,
write('% * * * '),nl,
write('% 100 240 0 '),nl,
write('% '),nl,
write('% Figure 3. decision tree for a sequential search of projects. '),nl.
% to embedd the sequential project
% selection problem into a decision tree.
% second order construction.
%------------------------------------------------------------
%
order_of_projects((alpha->omega)).
order_of_projects((omega->alpha)).
% edited: 22-23 Feb 2003.
decision_tree(node(r),parent(null),
choice([node((alpha->omega)),node((omega->alpha))]),delay([0,0])).
decision_tree(node((G1->G2)),parent(r),chance(Z),prob(P)):-
order_of_projects((G1->G2)),
project(G1,_,_,_,probability(P)),
A = resolved(G1,_,_,_V1),
B = option((G2/A)),
C = or(A,B),
findall(node(C),(project(A,_,_,_,_)),Z).
decision_tree(node(C),parent((G1->G2)),choice(X),delay([0,0])):-
A = resolved(G1,_,_,_V1),
B = option((G2/A)),
C = or(A,B),
order_of_projects((G1->G2)),
decision_tree(node((G1->G2)),parent(r),chance(Z),prob(_)),
member(node(C),Z),
X = [node(A),node(B)].
decision_tree(node(D),payoff(Eq)):-
A = resolved(G1,_,_,_V1),
B = option((G2/A)),
C = or(A,B),
decision_tree(node(C),parent((G1->G2)),choice(X),delay(_)),
member(node(D),X),
expected_value_of(project(D),Eq,_V).
%
% ----------------------------------------------------------- %
% Arithmetic and so on including probabilistic operators
% ----------------------------------------------------------- %
%
% max,min
% ----------------------------------------------------------- %
max_of(X,[X]).
max_of(Z,[X|Y]):-
max_of(Z1,Y),
(X > Z1 -> Z=X; Z=Z1).
min_of(X,[X]).
min_of(Z,[X|Y]):-
min_of(Z1,Y),
(X < Z1 -> Z=X; Z=Z1).
% count frequency of occurence of the specified value of variable, M.
% ----------------------------------------------------------- %
% note: Both of M and L have to be specified.
counter(N,M,L):-
length(L,_),
findall(M,member(M,L),Mx),
length(Mx,N).
% sum
% ----------------------------------------------------------- %
sum([],0).
sum([X|Members],Sum):-
sum(Members,Sum1),
%number(X),
Sum is Sum1 + X.
%
% product
% ----------------------------------------------------------- %
product([],1).
product([X|Members],Z):-
product(Members,Z1),
%number(X),
Z is Z1 * X.
%
% weighted sum
% ----------------------------------------------------------- %
product_sum([],[],[],0).
product_sum([P|Q],[A|B],[E|F],V):-
length(Q,N),
length(B,N),
product_sum(Q,B,F,V1),
E is P * A,
V is V1 + E.
product_sum_eq([],[],[],0,0).
product_sum_eq([P|Q],[A|B],[E|F],V,Vq):-
length(Q,N),
length(B,N),
product_sum_eq(Q,B,F,V1,Vq1),
Eq = (P) * A,
E is Eq,
(Vq1=0 -> Vq = Eq; Vq = Vq1 + Eq),
V is V1 + E.
%
% allocation
% ----------------------------------------------------------- %
allocation(N,A,[X|Y]):-
allocation(N,A,A,[X|Y]).
allocation(0,_,0,[]).
allocation(N,A,B,[X|Y]):-
integer(A),
length([X|Y],N),
allocation(_N1,A,B1,Y),
% N1 is N - 1,
% sum(Y,B1),
K is A - B1 + 1,
length(L,K),
nth0(X,L,X),
B is B1 + X.
%
% probability (percentile) by using allocation
% ----------------------------------------------------------- %
probabilities(0,[]).
probabilities(N,[X|Y]):-
integer(N),
length([X|Y],N),
allocation(N,100,[X|Y]).
%
% any ratio (weight) can be interpreted into a prob.
%---------------------------------------------
scale(W,1/Z,P):-
findall(Y,(nth1(_K,W,X),Y is X/Z),P).
probabilities(W,N,P):-
length(W,N),
sum(W,Z),
scale(W,1/Z,P).
%
% degenerate probability
%---------------------------------------------
degenerate(Ps):-
nth1(K,Ps,P),
characteristic_vector(K,P,Ps,Ps).
%
% probablity distribution with step values.
%---------------------------------------------
make_a_prob(P,base(M),steps(L)):-
var(P),
length(P,M),
allocation(M,L,W),
probabilities(W,M,P).
make_a_prob(P,base(M),_):-
\+ var(P),
length(P,M),
\+ (
member(P1,P),
(
var(P1);
P1 > 1;
P1 < 0
)
),
sum(P,1).
%
% expected value
% ----------------------------------------------------------- %
p_expected_value(W,A,E):-
length(A,N),
probabilities(W,N,P),
product_sum(P,A,_,E).
p_expected_value_eq(W,A,E,Eq):-
length(A,N),
probabilities(W,N,P),
product_sum_eq(P,A,_,E,Eq).
%
% conditional probabilities
% ----------------------------------------------------------- %
probability_of_event(W,E,P):-
% conditionalization by event specified directly
event(E),
(var(E)->E = E1; sort(E,E1)),
G = member(S,E1),
findall(A,(probability(W,S,A),G),Ps),
sum(Ps,P).
probability_of_event(W,E,P,G):-
\+ var(G), % conditionalization via constraints indirectly
G=(Goal,M,[W,S,A]), % constraints with params
findall([S1,A1],
(
(M=do->(W=W1,S=S1,A=A1);true),
probability(W1,S1,A1),
Goal
),
Xs),
findall(S,member([S,A],Xs),E0),
findall(A,member([S,A],Xs),Ps),
sort(E0,E),
sum(Ps,P).
%
% ----------------------------------------------------------- %
% Utilities for list operations
% ----------------------------------------------------------- %
%
% index for tuples.
% ----------------------------------------------------------- %
% 1) only mention for a direct product of sets.
index_of_tuple(B,A,Index):-
\+ var(B),
\+ var(A),
length(B,LN), % base sets
length(A,LN),
length(Index,LN),
findall(L,
(
nth1(K,B,BJ), %write(a(K,B,BJ)),
nth1(L,BJ,AJ),%write(b(L,BJ,AJ)),
nth1(K,A,AJ) %,write(c(K,A,AJ)),nl
),
Index).
index_of_tuple(B,A,Index):-
\+ var(B),
\+ var(Index),
var(A),
length(B,LN), % base sets
length(Index,LN),
length(A,LN),
findall(AJ,
(
nth1(K,B,BJ),
nth1(K,Index,L),
nth1(L,BJ,AJ)
),
A).
%
% descending/ascending natural number sequence less than N.
% ----------------------------------------------------------- %
dnum_seq([],N):-N<0,!.
dnum_seq([0],1).
dnum_seq([A|Q],N):-
A is N - 1,
length(Q,A),
dnum_seq(Q,A).
anum_seq(Aseq,N):-dnum_seq(Dseq,N),sort(Dseq,Aseq).
%
% inquire the goal multiplicity
% ----------------------------------------------------------- %
sea_multiple(Goal,Cond,N,M):-
Clause=..Goal,
findall(Cond,Clause,Z),length(Z,N),sort(Z,Q),length(Q,M).
%
% bag0/3 : allow multiplicity
% ----------------------------------------------------------- %
bag0([],_A,0).
bag0([C|B],A,N):-length([C|B],N),bag0(B,A,_N1),%N is N1 + 1,
member(C,A).
%
% bag1/3 : do not allow multiplicity
% ----------------------------------------------------------- %
% modified: 15 Oct 2002. bag fixed for unboundness.
bag1([],_A,0).
bag1([C|B],A,N1):-
\+var(A),
length(A,L),
asc_nnseq(Q,L),
member(N,Q),
length(B,N),bag1(B,A,N),N1 is N + 1,
member(C,A),\+member(C,B).
%
% ordering/3
% ----------------------------------------------------------- %
ordering(A,B,C):-bag1(A,B,C).
zeros(Zero,N):-bag0(Zero,[0],N).
ones(One,N):-bag0(One,[1],N).
%
% subset_of/3 : subset-enumeration
% ----------------------------------------------------------- %
subset_of(A,N,As):-
length(As,L),
length(D,L),
list_projection(D,As,B),
length(B,N),
sort(B,A).
% a sequence of binary choice for a list:
%--------------------------------------------------
list_projection([],[],[]).
list_projection([X|Y],[_A|B],C):-
X = 0,
list_projection(Y,B,C).
list_projection([X|Y],[A|B],[A|C]):-
X = 1,
list_projection(Y,B,C).
%
% characteristic_vector/3
% ----------------------------------------------------------- %
% modified: 8 Feb 2003. without using nth1.
% modified: 13 Feb 2003. bug fix. without using member.
characteristic_vector(X,B,Index):-
\+ var(B),
%member(X,B),
list_projection(Index,B,[X]).
characteristic_vector(1,X,[X|B],[1|DX]):-
characteristic_vector(X,[X|B],[1|DX]).
characteristic_vector(K,X,[_|B],[0|DX]):-
characteristic_vector(K1,X,B,DX),
K is K1 + 1.
%
% replace(Project,Goal,Base,Goal1):-
% ----------------------------------------------------------- %
% added: 15 Oct 2002.
% a sequence of replacement of a subset of elements in Goal
% which specified by a list, Project, 0-1^n, over Base
% a list of length n, which brings about Goal1.
% summary:
% X=1 --> preserve the value of Base.
% X=0 --> do replace with Goal1.
replace([],[],[],[]).
replace([X|A],[_|B],[Z|C],[Z|D]):-
X = 0,
replace(A,B,C,D).
replace([X|A],[Y|B],[_|C],[Y|D]):-
X = 1,
replace(A,B,C,D).
%
% replace/4 another version
% ----------------------------------------------------------- %
% modified: 14 Feb 2003. bug fix.
replace(K/N,L,S,L1):-
\+ var(S),
\+ var(L),
length(L,N),
length(L1,N),
nth1(K,L1,S),
characteristic_vector(K,_S0,L,V),
c_replace(V,L,L1,L1).
%
c_replace([],[],[],[]).
c_replace([X|A],[_|B],[Z|C],[Z|D]):-
X = 1,
c_replace(A,B,C,D).
c_replace([X|A],[Y|B],[_|C],[Y|D]):-
X = 0,
c_replace(A,B,C,D).
%
% complementary list projection
%--------------------------------------------------
% added: 10 Jan 2003.
c_list_projection(X,Y,Z):-
complement(X,XC,_N),
list_projection(XC,Y,Z).
complement(X,XC,N):-
\+ (var(X),var(N)),
bag0(X,[1,0],N),
zeros(Zero,N),
ones(One,N),
replace(X,Zero,One,XC).
%
% ----------------------------------------------------------- %
% Utilities for outputs
% ----------------------------------------------------------- %
%
% write and new line.
% ----------------------------------------------------------- %
wn(X):-write(X),nl.
%
% output to file.
% ----------------------------------------------------------- %
tell_test(Goal):-
open('tell.txt',write,S),
tell('tell.txt'),
Goal,
current_stream('tell.txt',write,S),
tell(user),wn(end),
close(S).
%
%end
/* abolished, or wreck */
return to front page.