% Kruskal count (2010/12/9, revised 12/11) % Reference: % Fulves, C. & Gardner, M.(1975): % The Kruskal principle. The Pallbearer's review, 10(8), 967-976. numb(I):- length( L, 13), nth1( I, L, _). suit(S, K):- nth1( K, [c, h, s, d], S). card(S, K, I):- suit( S, K), numb(I). :- dynamic c/3. % initialize and shuffle the deck init_deck:- retractall( c(_,_,_)), card(S, _, I), P is random(100000), assert( c( P, S, I) ), fail; true. show_all_deck:- X = c(_,_,_), findall( X, X, O), sort( O, H), member(X, H), nl, write(X), fail; true. /* ?- init_deck. ?- show_all_deck. c(1957, s, 11) c(3756, d, 1) c(3944, c, 6) c(4689, d, 10) c(5418, d, 7) ... */ :- dynamic kc/2. % initialize key numbers data init_kc:- retractall( kc(_,_)). % Key number reference: all face cards are 5. knum( J, J):- J =< 10. knum( J, 5):- J > 10. % The Krascal count procedure mentally_choosed_number(K):- length(L, 10), nth1(K, L,_). kcount( M, K):- mentally_choosed_number( M), % init_deck, % init_kc, X = c(_, _, _), findall( X, X, O), sort( O, H), kcount( M, H, K), assert( kc( M, K) ). kcount( M, H, K):- length( L, M), append( L, [Y | R], H), Y = c(_, _, K_next), debugmode(Y), knum( K_next, J), kcount( J, [Y|R], K). % find the tapped number kcount( K, H, K):- length( H, U), U =< K. :- dynamic debug/1. %debug( on). debugmode(X) :- clause(debug(on),_), !, nl, write(X). debugmode(_). stat_kc:- findall( M -> K, kc(M, K), O), sort(O, H), member(J -> K, H), findall(1, member(J -> K, O), U), length(U, D), nl, write( J-> K : [D]), fail; true. /* % debug mode on ?- init_deck, init_kc. ?- kcount(M, K). c(5918, s, 5) c(11020, h, 3) c(14855, c, 4) c(27526, s, 6) c(46920, h, 2) c(49051, d, 1) c(53425, d, 6) c(79697, c, 1) c(80642, d, 13) c(87048, h, 4) c(95203, h, 11) M = 1, K = 5 ; c(6916, h, 12) c(13601, c, 12) c(21014, c, 10) c(47857, d, 3) c(57695, s, 7) c(80642, d, 13) c(87048, h, 4) c(95203, h, 11) M = 2, K = 5 ; % debug mode off ?- init_all, kcount(M, K), fail; stat_kc. 1->8:[1] 2->8:[1] 3->8:[1] 4->8:[1] 5->8:[1] 6->8:[1] 7->8:[1] 8->8:[1] 9->8:[1] 10->8:[1] */ violate_kc:- \+ \+ violate_kc( _, _). violate_kc( M):- kc( M, K), kc( _, J), K \= J. run_kcount_for_all_mental_numbers_at_step( _):- init_kc, mentally_choosed_number(M), kcount( M, _), fail. run_kcount_for_all_mental_numbers_at_step( I):- mentally_choosed_number(M), rec_kc_failures( M, I), fail ; true. :- dynamic kcv/2. rec_kc_failures( M, I):- violate_kc(M), assert( kcv( M, I)). init_kcv:- abolish( kcv/2). % count of violations count_kc_violations( M, K):- mentally_choosed_number(M), findall( 1, kcv(M ,_), O), length(O, K). count_gross_total_kc_violations( K):- findall( 1, kcv(_, _ ), O), length(O, K). kc_violations(I):- count_gross_total_kc_violations( I). run_ntimes_kc( N):- init_kcv, length(L, N), member(I, L), init_deck, run_kcount_for_all_mental_numbers_at_step(I), fail ; true. stat_kcv:- count_kc_violations(M, V), nl, write('mental number': M -> (V-violations)), fail ; nl. stat_kc_success_prob( N):- count_kc_violations(M, V), A is V / (N * 10), B is (1 - A), nl, write( M-> B), fail. stat_kc_success_prob( N):- total_kc_success_prob( N, P), nl, write( 'total prob of success': P). total_kc_success_prob( N, P):- count_gross_total_kc_violations(I), A is I/( N * 10 * 10), P is (1 - A). /* ?- init_deck, init_kc. Yes ?- run_ntimes_kc( 100), stat_kc. ?- run_ntimes_kc( 100), stat_kc. 1->6:[1] 2->5:[1] 3->6:[1] 4->5:[1] 5->6:[1] 6->6:[1] 7->6:[1] 8->5:[1] 9->6:[1] 10->5:[1] Yes ?- init_all. true. ?- N=10000, run_ntimes_kc(N), stat_kcv. mental number:1->13376-violations mental number:2->13564-violations mental number:3->13679-violations mental number:4->13988-violations mental number:5->14354-violations mental number:6->14496-violations mental number:7->14682-violations mental number:8->14888-violations mental number:9->15141-violations mental number:10->15362-violations N = 10000. ?- stat_kc_success_prob(10000). 1->0.86624 2->0.86436 3->0.86321 4->0.86012 5->0.85646 6->0.85504 7->0.85318 8->0.85112 9->0.84859 10->0.84638 total prob of success:0.85647 true. % Note that if a recursive condition kcount( J, [Y|R], K) % in the second rule of kcount/3 is (wrongly:-) replaced with % kcount( J, R, K), then the correction rate decreases to about 0.75. */ init_all:- init_deck, init_kc, init_kcv. %