27 Cards Trick

[bplus]

Hi all,

I saw this trick come up after Steve's "Flip It" link and was amazed!

Finding a persons card out of 27 with 3 clues, not bad.

But putting that card anywhere in the deck to be drawn at number n with just 3 re-stacks, Fantastic!
(Of course, you will have to trust that it is just 3 restacks or read the code.)

Like this (mod2 Update):

Code: QB64: [Select]

1. OPTION _EXPLICIT
2.  
3. _TITLE "27 Cards Trick" ' B+ started 2019-11-06
4. ' Saw this on Internet after Steve's Flip It link   [youtube]https://www.youtube.com/watch?v=l7lP9y7Bb5g[/youtube]
5. ' Cool! I wonder if it works half as well as computer program? Let's see!
6. ' So I barrowed Steve's Cards and some code for the presentation.
7. ' 2019-11-08 some changes in wording per jack's suggestion and added do again option.
8. ' 2019-11-10 27 Cards Trick mod 2 attempt a more elegant stacking sub, good success!
9. ' eliminated several variables and arrays.
10.  
11. DEFINT A-Z
12. CONST cardW = 72, cardH = 96, marg = 50, mint = &HFF88DDAA
13.  
14. DIM SHARED Deck(51)
15. DIM SHARED CardImage AS LONG: CardImage = _LOADIMAGE("Cards.bmp", 32)
16. DIM SHARED xSpace, ySpace
17. DIM SHARED table(0 TO 8, 0 TO 2) ' store card indexes as layed out each time
18. DIM SHARED pass(1 TO 3)
19. DIM fav, cardsAbove, col, row, i, p$, pick$, f$
20.  
21. SCREEN _NEWIMAGE(800, 600, 32)
22. _SCREENMOVE 200, 60
23. RANDOMIZE TIMER
24. xSpace = (_WIDTH - 2 * marg) / 9
25. ySpace = (_HEIGHT - 2 * marg) / 3
26. WHILE _KEYDOWN(27) = 0
27.     favAgain:
28.     COLOR &HFFAAAAFF, &HFF000044: CLS
29.     yCP 160, "* * *  The 27 Cards Trick  * * *"
30.     yCP 200, "I present to you a 27 cards trick I learned from the Internet."
31.     yCP 220, "I will shuffle the deck, and lay out 27 cards in 3 rows."
32.     yCP 240, "You just need to pick a card and tell me which row the card is in."
33.     yCP 260, "I will deal cards 2 more times and ask for the row the card is in now."
34.     yCP 280, "I will then show you your card."
35.     COLOR mint
36.     inputG 132, 320, "But first, enter your favorite number between 1 and 27 (inclusive)", f$, 4
37.     fav = VAL(f$)
38.     cardsAbove = fav - 1
39.     IF fav > 0 AND fav < 28 THEN
40.         pass(3) = INT(cardsAbove / 9)
41.         pass(2) = INT((cardsAbove - 9 * pass(3)) / 3)
42.         pass(1) = (cardsAbove - 9 * pass(3)) - pass(2) * 3
43.     ELSE
44.         yCP 340, "Number needs to be > 0 and < 28. Try again."
45.         _DELAY 2
46.         GOTO favAgain
47.     END IF
48.  
49.     CLS
50.     Shuffle
51.     FOR i = 1 TO 3
52.         IF i = 1 THEN
53.             p$ = "Choose any card then enter the row: 1, 2 or 3 that card is on >"
54.         ELSEIF i = 2 THEN
55.             p$ = "Again, enter the row: 1, 2 or 3 that the card is on now >"
56.         ELSEIF i = 3 THEN
57.             p$ = "One last time, enter the row: 1, 2 or 3 that the card is now on >"
58.         END IF
59.         tryAgain:
60.         deal27
61.         inputG (_WIDTH - 8 * LEN(p$)) / 2, _HEIGHT - 40, p$, pick$, 5
62.         IF INSTR("123", pick$) THEN
63.             stacks2deck pass(i), pick$
64.         ELSE
65.             'go back and get a proper row
66.             GOTO tryAgain
67.         END IF
68.     NEXT
69.  
70.     CLS: i = 0
71.     FOR row = 0 TO 2
72.         FOR col = 0 TO 8
73.             DisplayCard col * xSpace + marg, row * ySpace + marg, Deck(i)
74.             i = i + 1
75.             LINE (_WIDTH - 100, _HEIGHT - 100)-STEP(100, 100), &HFF000044, BF
76.             Text _WIDTH - 98, _HEIGHT - 98, 80, mint, _TRIM$(STR$(i))
77.             IF i = fav THEN GOTO quiz
78.             _DELAY .5
79.         NEXT
80.     NEXT
81.  
82.     quiz:
83.     p$ = "Isn't that your card at your favorite number," + STR$(fav) + ", on the end?"
84.     inputG 50, _HEIGHT - 40, p$, f$, 5
85.     CLS
86.     p$ = "Want to see the trick again? enter y for yes, any other for no >"
87.     inputG (_WIDTH - 8 * LEN(p$)) / 2, _HEIGHT / 2 + 10, p$, f$, 15
88.     IF LCASE$(f$) <> "y" THEN CLS: END
89. WEND
90.  
91. SUB deal27
92.     DIM col, row, i
93.     CLS
94.     FOR col = 0 TO 8
95.         FOR row = 0 TO 2
96.             DisplayCard col * xSpace + marg, row * ySpace + marg, Deck(i)
97.             table(col, row) = Deck(i)
98.             i = i + 1
99.             _DELAY .1
100.         NEXT
101.     NEXT
102. END SUB
103.  
104. ' I am sure there is a less awkward way to do this but I am eager to share, mod 2 YES! there is!
105. SUB stacks2deck (place, pick$)
106.     DIM nPick, i
107.     nPick = VAL(pick$) - 1
108.     FOR i = 0 TO 8
109.         Deck(i + place * 9) = table(i, nPick)
110.         Deck(i + ((place + 1) MOD 3) * 9) = table(i, ((nPick + 1) MOD 3))
111.         Deck(i + ((place + 2) MOD 3) * 9) = table(i, ((nPick + 2) MOD 3))
112.     NEXT
113. END SUB
114.  
115. SUB DisplayCard (x, y, index)
116.     DIM suit, value
117.     suit = index \ 13: value = index MOD 13
118.     _PUTIMAGE (x, y)-STEP(cardW, cardH), CardImage, 0, (value * cardW, suit * cardH)-STEP(cardW, cardH)
119. END SUB
120.  
121. SUB yCP (y, s$) 'for xmax pixel wide graphics screen Center Print at pixel y row
122.     _PRINTSTRING ((_WIDTH - LEN(s$) * 8) / 2, y), s$
123. END SUB
124.  
125. SUB Shuffle
126.     DIM i
127.     FOR i = 0 TO 51: Deck(i) = i: NEXT 'put the cards in the deck
128.     FOR i = 0 TO 51: SWAP Deck(i), Deck(INT(RND * 52)): NEXT
129. END SUB
130.  
131. 'INPUT for Graphics screen
132. SUB inputG (x, y, prmpt$, var$, expectedLenVar%) 'input for a graphics screen x, y is where the prompt will start , returns through var$
133.     DIM tmp$, k$, saveAD
134.     saveAD = _AUTODISPLAY
135.     _KEYCLEAR
136.     _PRINTSTRING (x, y), prmpt$ + " {}"
137.     DO
138.         k$ = INKEY$
139.         IF LEN(k$) = 1 THEN
140.             SELECT CASE ASC(k$)
141.                 CASE 13: var$ = tmp$: EXIT SUB
142.                 CASE 27: var$ = "": EXIT SUB
143.                 CASE 8 'backspace
144.                     IF LEN(tmp$) THEN
145.                         IF LEN(tmp$) = 1 THEN tmp$ = "" ELSE tmp$ = LEFT$(tmp$, LEN(tmp$) - 1)
146.                     END IF
147.                 CASE ELSE: IF ASC(k$) > 31 THEN tmp$ = tmp$ + k$
148.             END SELECT
149.             _PRINTSTRING (x, y), prmpt$ + " {" + tmp$ + "}" + SPACE$(expectedLenVar% - LEN(tmp$)) 'spaces needed at end to clear backspace chars
150.             IF saveAD <> -1 THEN _DISPLAY
151.         END IF
152.         _LIMIT 120
153.     LOOP
154. END SUB
155.  
156. SUB Text (x, y, textHeight, K AS _UNSIGNED LONG, txt$)
157.     DIM fg AS _UNSIGNED LONG, cur&, I&, mult, xlen
158.     fg = _DEFAULTCOLOR
159.     'screen snapshot
160.     cur& = _DEST
161.     I& = _NEWIMAGE(8 * LEN(txt$), 16, 32)
162.     _DEST I&
163.     COLOR K, _RGBA32(0, 0, 0, 0)
164.     _PRINTSTRING (0, 0), txt$
165.     mult = textHeight / 16
166.     xlen = LEN(txt$) * 8 * mult
167.     _PUTIMAGE (x, y)-STEP(xlen, textHeight), I&, cur&
168.     COLOR fg
169.     _FREEIMAGE I&
170. END SUB
171.  

The cards and source code (above) in one nice little .zip package:

Update: 2019-11-08 I have modified the code above since original post (the zip file is still the same).
jack suggested some better wording and I added a do again option and some other minor things.

Update: 2019-11-10 Found much more elegant code to handle the stacking of rows of cards and eliminated some variables and arrays.

Update: 2019-11-10 OK xSpace and ySpace definitely don't need to be recalc'd every loop. Just changed code above.

[jack]

hi bplus
you say "choose a number between 1 an 27 inclusive" then later you say "enter row 1, 2, 3, your car is sitting on"
I am confused, there are no cards with numbers above 10, please explain
never mind, I got it
nice trick

[SMcNeill]

I saw the same video for this trick, and tried to amp it up to 256 cards — 4 rows of 64, dealt and chosen 4 times, but I got myself lost working it out.  Theory says it should work (and I can find the card doing so), but I can’t position it where I want in the deck yet. 

I was thinking ASCII is 256 characters, so 256 choices would be nice, but I just flubbed it up somewhere.  Maybe you’d want to take a shot to step it up a notch and give it a go.  (Heck, afterwards, you can even share the code/exe with the video guys.  Maybe they’ll give a little shout out to us and raise a little more QB64 interest out there in WWWland!)

[bplus]

Hi jack,

Thanks for feedback. If there is better way to word the prompts I am all ears,it's such a cool trick I want to present it well.


Hi Steve,

My first goal with this is to see if I can get that awkward section more elegantly written (sort of your area). If I can, I may take on higher amounts of cards, I was even considering what new suits I may make up for custom cards. :)
One trick in setting this up is figuring the nines, threes, ones number in base 3 of favorite number. You figure them going in one direction and then use them in the opposite.

[jack]

bplus, I suggest that on the first screen of cards that instead of "Enter the row: 1, 2 or 3, your card is sitting in "
you say "choose any card, then enter the row: 1, 2 or 3, your card is sitting in "
then in the subsequent screen of card you say "Enter the row: 1, 2 or 3, your card is sitting in "

[doppler]

Not much of a trick, it's a very old card trick.  It's also called binary search method.  It's 2 to the power of x attempts.  Pick a number between 1 and 100.  I will guess it with 7 tries.  You only have to tell me if your number is higher or lower than the number I say.  2^7 power is 128.  Since 100 is less than 128.  It's a guarantee to be found.  It's more fun, give me 20 guesses and I will find it in 1,000,000.  A play off the 20 questions game.

The card trick I remember uses 21 cards.  Three rows of 7.  Tell me what row the card is in.  As long as I put that row in the center of the deck.  After 3 card rounds.  The fourth from the top in center row will be the card.  I like to change up the end.  I remember the card and suit.   Ask the mark to shuffle the deck.  Give back the deck.  Fan out all the cards.  Locate the card and say "Here is your card."  They always suspect I position the card next to another card.  But I let them shuffle as many times as they want (mess up the card order).  The trick works because 2^3 is 8, seven cards in a row.  The cards will binary sort after three rounds.  This forces the marks card in position 11.  10 cards above and 10 cards below.

[bplus]

Hi Doppler,

It's not Binary, Binary would work like this:
27 / 2                  1st guess narrows down to 13.5 say 14 cards or say 13 whatever
14 / 2 = 7            2nd guess narrows to 7 cards
7/2                      3rd guess narrows to 3.5 cards
3.5/2                   4th guess still not guaranteed to have it! depends how you split 3.5, 1 or 2

Hi Lo game is Binary and goes like this, say the secret number is 1
You guess 13, high
you guess 6, high
you guess 3, high  >>>> you still need to guess!
you guess 2, high

This card game is done in 3 clues! (and you need all 3, again unlike Binary) Binary still has a ways to go for worst case scenario.

And you are missing the coolest part, putting the card anywhere in the deck. So that at the end of the guessing you count out the "mark's" favorite number of cards and THERE you find his card in the deck. There is no more fooling around after the 3 clues, the card is found at the mark's number in the deck.

I saw the 21 cards trick just before this trick and this trick is 2 x's cooler at least!
Here check the link:

[bplus]

Thanks jack, that will be in next edit.

[bplus]

OK the OP (original post) has been modified with changes in wording and added a do again loop, the code in the zip file is still the same for now.

[bplus]

Yes there was a much more elegant way to write this sub:

Code: QB64: [Select]

1. ' I am sure there is a less awkward way to do this but I am eager to share
2. SUB stacks2deck (place, pick$)
3.     DIM i, j
4.     SELECT CASE place
5.         CASE 0 'make deck 0-8 = picked stack
6.             FOR i = 0 TO 8
7.                 SELECT CASE pick$
8.                     CASE "1": Deck(i) = stack0(i)
9.                         FOR j = 9 TO 17
10.                             Deck(j) = stack1(j - 9)
11.                         NEXT
12.                         FOR j = 18 TO 26
13.                             Deck(j) = stack2(j - 18)
14.                         NEXT
15.                     CASE "2": Deck(i) = stack1(i)
16.                         FOR j = 9 TO 17
17.                             Deck(j) = stack2(j - 9)
18.                         NEXT
19.                         FOR j = 18 TO 26
20.                             Deck(j) = stack0(j - 18)
21.                         NEXT
22.                     CASE "3": Deck(i) = stack2(i)
23.                         FOR j = 9 TO 17
24.                             Deck(j) = stack0(j - 9)
25.                         NEXT
26.                         FOR j = 18 TO 26
27.                             Deck(j) = stack1(j - 18)
28.                         NEXT
29.                 END SELECT
30.             NEXT
31.         CASE 1 'make deck 9-17= picked stack
32.             FOR i = 9 TO 17
33.                 SELECT CASE pick$
34.                     CASE "1": Deck(i) = stack0(i - 9)
35.                         FOR j = 0 TO 8
36.                             Deck(j) = stack1(j)
37.                         NEXT
38.                         FOR j = 18 TO 26
39.                             Deck(j) = stack2(j - 18)
40.                         NEXT
41.                     CASE "2": Deck(i) = stack1(i - 9)
42.                         FOR j = 0 TO 8
43.                             Deck(j) = stack2(j)
44.                         NEXT
45.                         FOR j = 18 TO 26
46.                             Deck(j) = stack0(j - 18)
47.                         NEXT
48.                     CASE "3": Deck(i) = stack2(i - 9)
49.                         FOR j = 0 TO 8
50.                             Deck(j) = stack0(j)
51.                         NEXT
52.                         FOR j = 18 TO 26
53.                             Deck(j) = stack1(j - 18)
54.                         NEXT
55.                 END SELECT
56.             NEXT
57.         CASE 2 'make deck 18-26 = picked stack
58.             FOR i = 18 TO 26
59.                 SELECT CASE pick$
60.                     CASE "1": Deck(i) = stack0(i - 18)
61.                         FOR j = 0 TO 8
62.                             Deck(j) = stack1(j)
63.                         NEXT
64.                         FOR j = 9 TO 17
65.                             Deck(j) = stack2(j - 9)
66.                         NEXT
67.                     CASE "2": Deck(i) = stack1(i - 18)
68.                         FOR j = 0 TO 8
69.                             Deck(j) = stack2(j)
70.                         NEXT
71.                         FOR j = 9 TO 17
72.                             Deck(j) = stack0(j - 9)
73.                         NEXT
74.                     CASE "3": Deck(i) = stack2(i - 18)
75.                         FOR j = 0 TO 8
76.                             Deck(j) = stack0(j)
77.                         NEXT
78.                         FOR j = 9 TO 17
79.                             Deck(j) = stack1(j - 9)
80.                         NEXT
81.                 END SELECT
82.             NEXT
83.     END SELECT
84. END SUB

as this:

Code: QB64: [Select]

1. ' I am sure there is a less awkward way to do this but I am eager to share, mod 2 YES! there is!
2. SUB stacks2deck (place, pick$)
3.     DIM nPick, i
4.     nPick = VAL(pick$) - 1
5.     FOR i = 0 TO 8
6.         Deck(i + place * 9) = table(i, nPick)
7.         Deck(i + ((place + 1) MOD 3) * 9) = table(i, ((nPick + 1) MOD 3))
8.         Deck(i + ((place + 2) MOD 3) * 9) = table(i, ((nPick + 2) MOD 3))
9.     NEXT
10. END SUB
11.  

Also eliminated some variables and arrays in mod2 update.
So I will update original post with modifications and new zip.