Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: bplus on November 07, 2019, 03:41:28 pm

Title: 27 Cards Trick
Post by: bplus on November 07, 2019, 03:41:28 pm
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]
  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
  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
  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
  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
  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)
  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$
  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
  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
  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&
  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.
Title: Re: 27 Cards Trick
Post by: jack on November 07, 2019, 05:15:34 pm
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
Title: Re: 27 Cards Trick
Post by: SMcNeill on November 07, 2019, 05:41:14 pm
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!)
Title: Re: 27 Cards Trick
Post by: bplus on November 07, 2019, 07:15:09 pm
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.
Title: Re: 27 Cards Trick
Post by: jack on November 07, 2019, 07:22:25 pm
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 "
Title: Re: 27 Cards Trick
Post by: doppler on November 07, 2019, 08:35:43 pm
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.
Title: Re: 27 Cards Trick
Post by: bplus on November 07, 2019, 09:40:28 pm
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:


Title: Re: 27 Cards Trick
Post by: bplus on November 07, 2019, 10:04:20 pm
Thanks jack, that will be in next edit.
Title: Re: 27 Cards Trick
Post by: bplus on November 08, 2019, 02:15:39 am
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.
Title: Re: 27 Cards Trick
Post by: bplus on November 10, 2019, 01:00:44 pm
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

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
  11.  

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