prolog source code

You selected sea2.pl

title:-
T=['The secretary problem and the optimal stopping rule '
,'% file: sea2.pl'
,'% created: 14-19 Dec 2002.(by Kenryo INDO @ Kanto Gakuen University) '
,'% revised: 2 July 2004. '
,'% main: go/0. '
,'% reference: '
,'% [1] Y.S. Chow, S.Moriguti, H.Robins, and S.M. Samuels (1964). '
,'% Optimal selection based on relative rank (the "secretary problem"). Israel Journal of Mathematics 2:81-90.'
,'% [2] 森口繁一(1984).「海辺の美女の問題」所収『数学100の問題』日本評論社. p.39.'
],forall(member(C,T),(nl,write(C))).


/*
% 問題の説明：連続して提示される有限n 個の選択対象について、好みの順序(全部でn!とおり)が
等確率で発生する。しかしどの選好順序が発生したのか、選ぶ方は事前に知らない。実際に、
一つずつ、後戻りせず取り出して、採否を判断する。最後のｎ回まできたてしまったら必ず採択し
なければならないとする。この問題に対する最適停止ルールは、各回ｋについて、期待順位Ckと
留保順位Skが求まり、これを用いて途中までのサンプル列{X1,...,Xk}におけるXkの相対的順位yk
が留保順位Sｋ以下ならば採択、さもなくば探索を続けるというもの（上記文献[1,2]を参照）。
ちなみに文献[2]のBASICプログラムは１３行である。
*/

% Expected Rank
%--------------------------------

% C: expected rank. 
% K: time. 
% S: reservation level.
% B: coefficient for update expected_rank. 

steps(20).
expected_rank(N0,[C],[S]):-
	steps(N), 
	N0 is N - 1,
	C is (N + 1) / 2,
	reservation(N0,C,S).

expected_rank(K,[C|[C1|C0]],[S|[S1|S0]]):-
	expected_rank(K1,[C1|C0],[S1|S0]),
	((K1 =< 0; var(K1); var(C1))->!,fail;true),
	K is K1 - 1,
	steps(N),
	B is (N + 1) / (K1 + 1) * (S1 + 1) / 2 - C1,
	C is C1 + B * S1 / K1,
	reservation(K,C,S).

reservation(K,C,S):-
	% S: reservation level.
	\+ (var(K); var(C)),
	steps(N),
	N1 is N + 1,
	K1 is K + 1,
	S is integer( C * K1 / N1 - 0.5).


%-----------------------------------
%  Stopping Rule
%-----------------------------------

% S: reservation levels.
% C: expected ranks.

sea(accept(P),(time(H),exp(C),rsrv(S),data(Q),rel_rank(R)),Mode):-
	member(Mode,[prety,random]),
	steps(N),
	rank(Q,N,Mode),
	stopping_rule(S,N,H,P,Q,R,C).

stopping_rule(S,N,H,P,Q,R,C):-
	expected_rank(1,C1,S1),
	append(C1,[N],Cr),
	append(S1,[N],Sr),
	reverse(Cr,C),
	reverse(Sr,S),
	accept(N,H,Q,S,R,P).

accept(0,[],[],[],[],init).
accept(T,[T0|H],[O|W],[S|U],[Y|R],P):-
	relative_rank(O,[O|W],Y),
	accept(T0,H,W,U,R,Q),
	T is T0 + 1,
	accept_rule(T,Q,Y,S,P).

relative_rank(_A,[],0).
relative_rank(O,[W|E],Y):-
	relative_rank(O,E,Y1),
	(W =< O -> Y is Y1 + 1; Y is Y1).


accept_rule(_,Q,_Y,_S,P):-
	Q = accept(_,_,_),
	!,
	P = Q.

accept_rule(T,_Q,Y,S,P):-
	Y =< S,
	!,
	P = accept(time(T),reservation(S),relative_rank(Y)).

accept_rule(N,_Q,_Y,_S,P):-
	P = pass(N).


%--------------------------------
% a script program
%--------------------------------

go:-
	sea(A,(time(H),exp(B),rsrv(C),data(D),rel_rank(E)),random),nl,
	wln,
	forall(nth1(K,H,T0),
	  (
	    nl,
	    nth1(K,B,B1),
	    nth1(K,C,C1),nth1(K,D,D1),nth1(K,E,E1),
	    tab(5),
	    T is T0 + 1,
	    write((time(T),exp(B1),rsv(C1),sampl(D1),r_rank(E1))),
	    (C1 >= E1 -> write(' *') ;true)
	  )
	),
        wln,
	nl,tab(5),write(A).

wln:-
	nl,
	tab(5),
	write('-----------------------------------------------').

ask_steps:-
	write('How many goods ?'),
	read(N1),
	set_steps(N1).

set_steps(N1):-
	abolish(steps,1),
	assert(steps(N1)).


% rank /1 and ordering /3
%--------------------------------

rank(O,N,prety):-steps(N),nlist(L1,N),ordering(O,L1,prety).
rank(O,N,random):-steps(N),nlist(L1,N),ordering(O,L1,random).
nlist(L,N):-
	length(L1,N),bagof(K,L1^nth1(K,L1,K),L).
ordering(X,A,Type):-
	length(A,N),
	length(X1,N),
	nlist(B1,N),
	ordering(X1,B,A,Type),
	sort(B,B1),
	reverse(X1,X).
ordering([],[],_A,_).
ordering([X|Y],[K|B],A,prety):-
	\+ var(A),
	ordering(Y,B,A,prety),
	\+ (stop_ordering(A,Y),!,fail),
	subtract(A,Y,Z),
	member(X, Z),
	nth1(K,A,X).
ordering([X|Y],[K|B],A,random):-
	\+ var(A),
	ordering(Y,B,A,random),
	\+ (stop_ordering(A,Y),!,fail),
	subtract(A,Y,Z),
	sampling(A,K,Z,X),
	nth1(K,A,X).
stop_ordering(A,Y):-sort(A,N),sort(Y,N).

sampling(A,K,Z,X):-
	Z\=[],
	length(Z,Nz),
	K1 is random(Nz),write(K1),
	Kz is K1 + 1,
	nth1(Kz,Z,X),
	nth1(K,A,X).


:-title,nl,write('go?'),read(y),go.


%end
return to front page.