Prolog Puzzles

DigitProbabilities.pl

/* ---------------------------------------------------------------------------

How to calculate this probability?
Originally from a question by "Houwu Chen":
https://groups.google.com/d/msg/sci.math/YgvVT-SLvRg/RLn2agzZM7kJ
https://groups.google.com/d/msg/sci.math/YgvVT-SLvRg/2TC-NcV-AqoJ

UPDATED 2015-04-27: Fixed a bug in to_digit_probs__do/4.

Question:

- There is a reference word *R* with `K` bits, every bit of the word having the same
  probability `pm` of being zero.
  
- There are `D` candidate words *Ws* also with `K` bits, every bit of every of these words
  having the same probability `ph` of being zero.

- A candidate word *C* is selected from *Ws*, such that it has the minimum number
  of different bits from *R*, i.e. the minimum hamming distance from *R*.

Now, what is the probability that every bit in *C* is zero?

------------------------------------------------------------------------------

?- to_digit_probs([0.9],PDsS),to_digit_probs([0.2],PDsW).
PDsS = [9 rdiv 10, 1 rdiv 10],
PDsW = [1 rdiv 5, 4 rdiv 5].

?- time(test_comb_digits_prob(2,2,[0,0],$PDsS,$PDsW,_PDs)).
[0,0] -> [ 0.30752, 0.30752 ]
% 6,295 inferences, 0.000 CPU in 0.000 seconds (?% CPU, Infinite Lips)
true.

?- time((test_comb_digits_prob(2,2,Ds,$PDsS,$PDsW,_PDs),fail;true)).
[0,0] -> [ 0.30752, 0.30752 ]
[0,1] -> [ 0.30752, 0.69248 ]
[1,0] -> [ 0.69248, 0.30752 ]
[1,1] -> [ 0.69248, 0.69248 ]
% 25,151 inferences, 0.000 CPU in 0.016 seconds (0% CPU, Infinite Lips)
true.

?- time(test_comb_digits_prob(3,3,[0,0,0],$PDsS,$PDsW,_PDs)).
[0,0,0] -> [ 0.35839, 0.35839, 0.35839 ]
% 697,322 inferences, 0.328 CPU in 0.328 seconds (100% CPU, 2128564 Lips)
true.

--------------------------------------------------------------------------- */

% (SWI-Prolog)
:- use_module(library(aggregate)).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%	test_comb_digits_prob(+L, +M, +PDsS, +PDsW, -PDs)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

test_comb_digits_prob(L, M, Ds, PDsS, PDsW, PDs) :-
	string(L, Ds),
	comb_digits_prob(Ds, M, PDsS, PDsW, PDs),
	write(Ds), write(' -> [ '),
	test_comb_digits_prob__wrt(PDs),
	writeln(' ]').

test_comb_digits_prob__wrt([PDH, PDH1| PDT]) :-
	!,
	format('~5f, ', [PDH]),
	test_comb_digits_prob__wrt([PDH1| PDT]).
test_comb_digits_prob__wrt([PDH]) :-
	!,
	format('~5f', [PDH]).
test_comb_digits_prob__wrt([]).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%	comb_digits_prob(+Ds, +M, +PDsS, +PDsW, -PDs)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

comb_digits_prob(Ds, M, PDsS, PDsW, PDs) :-
	length(Ds, L),
	findall(
		R-PDsR,
		(	comb_string_prob(L, M, R, PDsS, PDsW, PR),
			comb_digits_prob__ws(Ds, R, PR, PDsR)
		),
		R_PDsR_Pairs
	),
	comb_digits_prob__sum(0, Ds, R_PDsR_Pairs, PDs).

comb_digits_prob__ws([DH| DT], [RH| RT], PR, [PDH| PDT]) :-
	!,
	(	DH =:= RH
	->	PDH is PR
	;	PDH is 0 rdiv 1
	),
	comb_digits_prob__ws(DT, RT, PR, PDT).
comb_digits_prob__ws([], [], _, []).

comb_digits_prob__sum(I, [DH| DT], R_PDsR_Pairs, [PDH| PDT]) :-
	!,
	comb_digits_prob__sum_rs(I, DH, R_PDsR_Pairs, 0 rdiv 1, PDH),
	I1 is I + 1,
	comb_digits_prob__sum(I1, DT, R_PDsR_Pairs, PDT).
comb_digits_prob__sum(_, [], _, []).

comb_digits_prob__sum_rs(I, DI, [R-PDsR| R_PDsR_T], Sum0, Sum) :-
	!,
	string_digit(I, R, DR),
	(	DI == DR
	->	list_element(I, PDsR, PDR),
		Sum1 is Sum0 + PDR
	;	Sum1 is Sum0
	),
	comb_digits_prob__sum_rs(I, DI, R_PDsR_T, Sum1, Sum).
comb_digits_prob__sum_rs(_, _, [], Sum, Sum).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%	comb_string_prob(+L, +M, -R, +PDsS, +PDsW, -PR)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

comb_string_prob(L, M, R, PDsS, PDsW, PR) :-
	aggregate(
		sum(PComb),
		S^Ws^PComb^
		(	string(L, S),
			comb_string_prob__ws(L, M, Ws),
			comb_prob(S, Ws, R, PDsS, PDsW, PComb)
		), PR
	).

comb_string_prob__ws(L, M, [W| Ws]) :-
	M > 0, !,
	M0 is M - 1,
	string(L, W),
	comb_string_prob__ws(L, M0, Ws).
comb_string_prob__ws(_, 0, []).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%	comb_prob(+S, +Ws, -R, +PDsS, +PDsW, -PComb)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

comb_prob(S, [W| Ws], R, PDsS, PDsW, PComb) :-
	string_prob(S, PDsS, PS),
	string_prob(W, PDsW, PW),
	string_diff(S, W, Diff0),
	PComb0 is PS * PW,
	comb_prob__do(S, Ws, Diff0, W, R, PDsW, PComb0, PComb).

comb_prob__do(S, [W| Ws], Diff0, R0, R, PDsW, PComb0, PComb) :-
	!,
	string_prob(W, PDsW, PW),
	string_diff(S, W, DiffW),
	(	DiffW < Diff0
	->	Diff1 is DiffW, R1 = W
	;	Diff1 is Diff0, R1 = R0
	),
	PComb1 is PComb0 * PW,
	comb_prob__do(S, Ws, Diff1, R1, R, PDsW, PComb1, PComb).
comb_prob__do(_, [], _, R, R, _, PComb, PComb).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%	string_prob(+S, +PDs, -PS)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

string_prob(S, PDs, PS) :-
	string_prob__do(S, PDs, 1 rdiv 1, PS).

string_prob__do([SH| ST], PDs, PS0, PS) :-
	!,
	digit_prob(SH, PDs, PSH),
	PS1 is PS0 * PSH,
	string_prob__do(ST, PDs, PS1, PS).
string_prob__do([], _, PS, PS).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%	digit_prob(+D, +PDs, -PD)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

digit_prob(D, PDs, PD) :-
	digit_idx(D, ID),
	list_element(ID, PDs, PD).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%	string(?S)
%%	string(+L, ?S)
%%	string_digit(+I, +S, -D)
%%	string_diff(+R, +S, -Diff)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

string(S) :-
	string(_, S).

string(L, S) :-
	length(S, L),
	string__do(L, S).

string__do(L, [SH| ST]) :-
	L > 0, !,
	L0 is L - 1,
	digit(SH),
	string__do(L0, ST).
string__do(0, []).

string_digit(I, S, D) :-
	list_element(I, S, D).

string_diff(R, S, D) :-
	string_diff__do(R, S, 0, D).

string_diff__do([RH| RT], [SH| ST], Diff0, Diff) :-
	!,
	digit_diff(RH, SH, DiffH),
	Diff1 is Diff0 + abs(DiffH),
	string_diff__do(RT, ST, Diff1, Diff).
string_diff__do([], [], Diff, Diff).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%	digit(?D)
%%	digit_cnt(-L)
%%	digit_idx(+D, -I)
%%	digit_diff(+D0, +D1, -Diff)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

digit(0).
digit(1).

digit_cnt(2).

digit_idx(D, I) :-
	I is D.

digit_diff(D0, D1, Diff) :-
	Diff is D1 - D0.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%	to_digit_probs(+PDs0, -PDs)
%%	list_element(+I, +Es, -E)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

to_digit_probs(PDs0, PDs) :-
	digit_cnt(L),
	L0 is L - 1,
	length(PDs0, L0),
	to_digit_probs__do(L0, PDs0, 0 rdiv 1, PDs).

to_digit_probs__do(L, [PDH0| PDT0], PDSum0, [PDH| PDT]) :-
	L > 0, !,
	L0 is L - 1,
	PDH is rationalize(PDH0),
	PDSum1 is PDSum0 + PDH,
	to_digit_probs__do(L0, PDT0, PDSum1, PDT).
to_digit_probs__do(0, [], PDSum0, [PDH]) :-
	PDSum0 =< 1,
	PDH is 1 - PDSum0.

list_element(I, [_| T], E) :-
	I > 0, !,
	I0 is I - 1,
	list_element(I0, T, E).
list_element(0, [E| _], E).