/* Kruskal count in Picat. https://en.wikipedia.org/wiki/Kruskal_count """ The Kruskal count (also known as Kruskal's principle, Dynkin–Kruskal count, Dynkin's counting trick, Dynkin's card trick, coupling card trick or shift coupling) is a probabilistic concept originally demonstrated by the Russian mathematician Evgenii Borisovich Dynkin in the 1950s or 1960s discussing coupling effects and rediscovered as a card trick by the American mathematician Martin David Kruskal in the early 1970s as a side-product while working on another problem. ... The trick is performed with cards, but is more a magical-looking effect than a conventional magic trick. The magician has no access to the cards, which are manipulated by members of the audience. Thus sleight of hand is not possible. Rather the effect is based on the mathematical fact that the output of a Markov chain, under certain conditions, is typically independent of the input. A simplified version using the hands of a clock is as follows. A volunteer picks a number from one to twelve and does not reveal it to the magician. The volunteer is instructed to start from 12 on the clock and move clockwise by a number of spaces equal to the number of letters that the chosen number has when spelled out. This is then repeated, moving by the number of letters in the new number. The output after three or more moves does not depend on the initially chosen number and therefore the magician can predict it. """ Here are both the clock version and the card version. Cf my Gamble model gamble_kruskal_count.rkt This program was created by Hakan Kjellerstrand, hakank@gmail.com See also my Picat page: http://www.hakank.org/picat/ */ import ppl_distributions, ppl_utils. import util. % import ordset. main => go. /* Clock version var : a Probabilities: [3,8,1,4,8,1]: 0.3331000000000000 [5,9,1,4,8,1]: 0.2523000000000000 [4,8,1,4,8,1]: 0.2477000000000000 [6,9,1,4,8,1]: 0.1669000000000000 mean = [[3,8,1,4,8,1] = 0.3331,[5,9,1,4,8,1] = 0.2523,[4,8,1,4,8,1] = 0.2477,[6,9,1,4,8,1] = 0.1669] var : last a Probabilities: 1: 1.0000000000000000 mean = 1.0 */ go ?=> reset_store, run_model(10_000,$model,[show_probs_trunc,mean % , % show_percentiles, % show_hpd_intervals,hpd_intervals=[0.94], % show_histogram, % min_accepted_samples=1000,show_accepted_samples=true ]), nl, % show_store_lengths,nl, % fail, nl. go => true. % Adjust for 0-based get_len(N,Names) = Names[N+1].len. f(A,Names) = Res => ALen = A.len, LastA = A.last, if ALen > 5 then Res = A else Len = (LastA + get_len(LastA,Names)) mod 12, Res = f(A ++ [Len],Names) end. model() => Names = ["twelve","one","two","three","four","five","six","seven","eight","nine","ten","eleven"], Start = random_integer(12), % 0..11 A = f([get_len(Start,Names)],Names), LastA = A.last, add("a",A), add("last a",LastA). /* Card version https://www.ams.org/publicoutreach/feature-column/fcarc-mulcahy6 """ Effect: The victim shuffles a deck thoroughly, then secretly picks a number between 1 and 10. The cards are dealt out slowly and steadily, face up, the victim's first key card being the one at the position they choose in advance. The value of this card determines how many to deal out to the next key card, e.g., if the key card is a 4 victim counts off four cards, the last being the new key card. Royal cards count 5. The process is repeated as often as is possible. Eventually they will get a key card (perhaps the last card in the deck) which is not followed by enough cards to get to another one; this last key card is the one they remember. No matter how steadily the victim deals, with no pauses to give any hints as to which cards are key cards, you successfully identify their last key card. For many people, this trick grows more mysterious with repetition. Method: The method is simple: you yourself follow the same instructions as the victim deals off the cards, picking at random some card among the first ten, and so on, finally arriving at your own last key card. The amazing thing is that with very high probability you'll both have come to the same final key card. In fact, your apparantly independently determined streams will most often flow together somewhere along the way, sometimes before you are even half way through the deck! """ * Here are some runs where it works cards = [2,4,8,12,7,4,7,8,11,8,11,9,12,13,2,10,1,6,13,10,3,5,8,9,3,10,4,5,2,13,3,10,5,6,3,13,1,11,1,4,6,9,12,6,7,1,5,12,9,11,7,2] var : a Probabilities: [9,13,13,9,5,11,12,12]: 0.1110000000000000 [7,13,13,9,5,11,12,12]: 0.1090000000000000 [3,11,10,3,9,5,11,12,12]: 0.1030000000000000 [2,4,8,6,9,5,11,12,12]: 0.1010000000000000 [1,8,11,10,3,9,5,11,12,12]: 0.1000000000000000 [4,11,13,13,9,5,11,12,12]: 0.0980000000000000 [5,9,3,9,5,11,12,12]: 0.0960000000000000 [6,8,6,9,5,11,12,12]: 0.0950000000000000 [10,6,9,5,11,12,12]: 0.0940000000000000 [8,10,3,9,5,11,12,12]: 0.0930000000000000 var : last a Probabilities: 12: 1.0000000000000000 var : pos Probabilities: 48: 1.0000000000000000 cards = [8,13,4,8,12,12,2,13,9,6,2,12,9,6,8,1,6,11,7,10,9,7,5,4,1,5,11,4,2,12,4,1,3,5,13,10,9,13,1,6,10,7,5,11,3,3,8,2,7,11,3,10] var : a Probabilities: [1,9,11,5,4,1,3,10,10,3,7]: 0.1280000000000000 [10,1,6,5,4,1,3,10,10,3,7]: 0.1080000000000000 [8,9,7,2,4,13,6,3,7]: 0.1070000000000000 [6,2,9,7,2,4,13,6,3,7]: 0.1070000000000000 [3,2,9,11,5,4,1,3,10,10,3,7]: 0.1030000000000000 [2,2,9,11,5,4,1,3,10,10,3,7]: 0.0970000000000000 [4,12,6,5,4,1,3,10,10,3,7]: 0.0910000000000000 [5,6,1,6,5,4,1,3,10,10,3,7]: 0.0900000000000000 [7,9,11,5,4,1,3,10,10,3,7]: 0.0860000000000000 [9,11,5,4,1,3,10,10,3,7]: 0.0830000000000000 var : last a Probabilities: 7: 1.0000000000000000 var : pos Probabilities: 49: 1.0000000000000000 cards = [10,12,11,2,11,11,3,7,9,8,1,5,6,9,4,3,2,7,6,2,5,8,13,13,3,9,1,10,10,2,10,12,6,4,4,12,4,9,6,1,1,5,8,7,5,11,13,8,3,12,7,13] var : a Probabilities: [7,8,7,3,10,6,6,5,12]: 0.1210000000000000 [9,7,3,10,6,6,5,12]: 0.1200000000000000 [10,7,3,10,6,6,5,12]: 0.1190000000000000 [6,1,5,2,6,3,10,6,6,5,12]: 0.1010000000000000 [1,11,1,5,2,6,3,10,6,6,5,12]: 0.1010000000000000 [8,4,6,3,10,6,6,5,12]: 0.0990000000000000 [5,8,7,3,10,6,6,5,12]: 0.0940000000000000 [4,11,1,5,2,6,3,10,6,6,5,12]: 0.0840000000000000 [3,7,4,6,3,10,6,6,5,12]: 0.0830000000000000 [2,3,8,7,3,10,6,6,5,12]: 0.0780000000000000 var : last a Probabilities: 12: 1.0000000000000000 var : pos Probabilities: 50: 1.0000000000000000 * And some where there are two different values: cards = [9,10,7,8,6,1,4,13,12,9,10,3,5,3,6,1,3,11,7,5,7,4,2,8,1,4,1,11,2,10,13,9,13,9,12,4,10,6,7,5,12,2,2,6,8,3,8,13,12,11,5,11] var : a Probabilities: [5,10,1,3,5,1,4,10,12,5,8]: 0.1310000000000000 [8,5,11,2,1,4,10,12,5,8]: 0.1210000000000000 [7,10,1,3,5,1,4,10,12,5,8]: 0.1050000000000000 [10,7,4,10,12,5,8]: 0.1010000000000000 [9,3,3,5,1,4,10,12,5,8]: 0.0990000000000000 [4,3,6,7,11,13,6,6,11]: 0.0940000000000000 [6,4,10,1,3,5,1,4,10,12,5,8]: 0.0930000000000000 [1,9,7,4,10,12,5,8]: 0.0900000000000000 [2,4,10,1,3,5,1,4,10,12,5,8]: 0.0870000000000000 [3,9,7,4,10,12,5,8]: 0.0790000000000000 var : last a Probabilities: 8: 0.9060000000000000 11: 0.0940000000000000 var : pos Probabilities: 45: 0.9060000000000000 50: 0.0940000000000000 cards = [8,3,4,8,5,7,6,12,2,8,2,7,7,6,13,11,9,3,13,5,8,12,6,1,3,11,4,12,11,13,5,1,9,12,3,4,5,9,7,9,10,1,13,1,11,10,6,4,10,2,2,10] var : a Probabilities: [9,2,7,5,3,12,9,1,13,4]: 0.1200000000000000 [4,7,13,1,3,12,9,1,13,4]: 0.1070000000000000 [8,7,5,3,12,9,1,13,4]: 0.1040000000000000 [6,7,5,3,12,9,1,13,4]: 0.1040000000000000 [2,5,8,3,8,11,12,7,10,2]: 0.1030000000000000 [3,6,7,5,3,12,9,1,13,4]: 0.0970000000000000 [10,3,8,11,12,7,10,2]: 0.0950000000000000 [5,8,3,8,11,12,7,10,2]: 0.0950000000000000 [7,7,5,3,12,9,1,13,4]: 0.0900000000000000 [1,2,2,7,5,3,12,9,1,13,4]: 0.0850000000000000 var : last a Probabilities: 4: 0.7070000000000000 2: 0.2930000000000000 var : pos Probabilities: 48: 0.7070000000000000 51: 0.2930000000000000 * I ran 1000 experiments (member(X,1..1000) and got this distribution of the number of unique last a: [3 = 17,2 = 322,1 = 661] There are about * 2/3 of unique solutions * 1/3 of two solutions * and a few (17) runs which had 3 different solutions For the variants with 2 solutions, there distribution of the two alternative is ofen uneven, e.g. 90/10, 70/30 (see above). */ go2 ?=> Map = get_global_map(), member(X,1..3), % run 3 times reset_store, % _ = random2(), Cards = draw_without_replacement(52,rep(4,1..13).flatten), println(cards=Cards), run_model(1000,$model2(Cards),[show_probs %, presentation=[] ]), % show_store_lengths,nl, NumDifferent = get_store().get("last a").remove_dups.len, println(num_different=NumDifferent), Map.put(NumDifferent,Map.get(NumDifferent,0)+1), nl, fail, nl. go2 => Map = get_global_map(), println(num_different_solutions=Map), nl. f2(Pos,A,Positions, Cards,CardLen) = Res => % println($f2(Pos,A,Positions, Cards,CardLen)), CLen = Cards.len, if Pos >= CLen then Res = [A,Pos,Positions] else Card = Cards[Pos], NextPos = Pos + CardLen[Card], if NextPos >= CLen then Res = [A,Pos,Positions] else NextCard = Cards[NextPos], Res = f2(NextPos,A++[NextCard],Positions++[NextPos], Cards,CardLen) end end. model2(Cards) => % Count value of each card: CardLen = [1,2,3,4,5,6,7,8,9,5,5,5,5], Start = random_integer1(10), % 1..10 % (define res (f start (list start (list-ref cards start)) (list start))) [A,Pos,Positions] = f2(Start,[Start], [Cards[Start]], Cards,CardLen), add("a",A), % add("positions",Positions), add("last a",A.last), % add("a len",A.len), add("pos",Pos).