Mind boggling card trick: Difference between revisions

Add Ada version
(Added FreeBASIC)
(Add Ada version)
 
(2 intermediate revisions by 2 users not shown)
Line 81:
Swapping 10
Yeha! The mathematicians assertion is correct.
</pre>
 
=={{header|Ada}}==
<syntaxhighlight lang="ada">
-- Check the "Mind boggling card trick"
-- J. Carter 2024 May
-- Uses the PragmAda Reusable Components (https://github.com/jrcarter/PragmARC)
 
with Ada.Text_IO;
with Ada.Numerics.Discrete_Random;
with PragmARC.Cards.Decks.US;
with PragmARC.Cards.US;
 
procedure Card_Trick is
package Cards renames PragmARC.Cards.US;
package Decks renames PragmARC.Cards.Decks.US;
function Is_Red (Card : in Cards.Card_Info) return Boolean is
(Card.Suit in Cards.Diamond | Cards.Heart);
function Correct return Boolean;
-- Performs the trick and returns True if the assertion that 'The number of black cards in the "black" pile equals the number
-- of red cards in the "red" pile' holds; False if it does not
function Correct return Boolean is
function Num_Red (Deck : in Decks.Deck_52) return Natural;
-- Returns the number of red cards in Deck
function Num_Black (Deck : in Decks.Deck_52) return Natural;
-- Returns the number of black cards in Deck
function Num_Red (Deck : in Decks.Deck_52) return Natural is
Result : Natural := 0;
begin -- Num_Red
Count : for I in 1 .. Deck.Size loop
if Is_Red (Deck.Value (I) ) then
Result := Result + 1;
end if;
end loop Count;
return Result;
end Num_Red;
function Num_Black (Deck : in Decks.Deck_52) return Natural is
(Deck.Size - Num_Red (Deck) );
Hand : Decks.Deck_52;
Red : Decks.Deck_52;
Black : Decks.Deck_52;
Card : Cards.Card_Info;
begin -- Correct
Decks.Standard_Deck (Item => Hand);
Hand.Shuffle;
All_Cards : loop
exit All_Cards when Hand.Is_Empty;
Hand.Deal (To => Card);
if Is_Red (Card) then
Hand.Deal (To => Card);
Red.Add (Item => Card);
else
Hand.Deal (To => Card);
Black.Add (Item => Card);
end if;
end loop All_Cards;
Swap : declare
Number : constant Natural := Integer'Min (Red.Size, Black.Size) - 1;
subtype Bunch_Value is Integer range 1 .. Number;
package Random is new Ada.Numerics.Discrete_Random (Result_Subtype => Bunch_Value);
Gen : Random.Generator;
Bunch : Bunch_Value;
begin -- Swap
Random.Reset (Gen => Gen);
Bunch := Random.Random (Gen);
One_Bunch : for I in 1 .. Bunch loop
Red.Deal (To => Card);
Black.Add (Item => Card);
Black.Deal (To => Card);
Red.Add (Item => Card);
end loop One_Bunch;
return Num_Red (Red) = Num_Black (Black);
end Swap;
end Correct;
Total : constant := 10_000;
Good : Natural := 0;
begin -- Card_Trick
Check_All : for I in 1 .. Total loop
if Correct then
Good := Good + 1;
end if;
end loop Check_All;
Ada.Text_IO.Put_Line (Item => Good'Image & " correct out of" & Total'Image & " tries");
end Card_Trick;
</syntaxhighlight>
 
{{out}}
<pre>
10000 correct out of 10000 tries
</pre>
 
Line 766 ⟶ 875:
Drumroll...
There were 7!
</pre>
 
=={{header|EasyLang}}==
{{trans|Wren}}
<syntaxhighlight>
proc shuffle . a[] .
for i = len a[] downto 2
r = randint i
swap a[r] a[i]
.
.
func$ a2str a[] .
for v in a[]
r$ &= strchar v & " "
.
return r$
.
R = strcode "R"
B = strcode "B"
for i to 26
pack[] &= R
pack[] &= B
.
shuffle pack[]
#
for i = 1 step 2 to 51
if pack[i] = B
black[] &= pack[i + 1]
else
red[] &= pack[i + 1]
.
discard[] &= pack[i]
.
print "After dealing the cards the state of the stacks is:"
print " Red : " & a2str red[]
print " Black : " & a2str black[]
print " Discard: " & a2str discard[]
for i to len red[]
rp[] &= i
.
for i to len black[]
bp[] &= i
.
shuffle rp[]
shuffle bp[]
n = randint lower len red[] len black[]
len rp[] n
len bp[] n
#
for i to n
h = red[rp[i]]
red[rp[i]] = black[bp[i]]
black[bp[i]] = h
.
print ""
print "After swapping " & n & " cards the state of the stacks is:"
print " Red : " & a2str red[]
print " Black : " & a2str black[]
#
for c in red[]
red += if c = R
.
for c in black[]
black += if c = B
.
print ""
print "The number of red cards in the red stack = " & red
print "The number of black cards in the black stack = " & black
if red = black
print "So the asssertion is correct!"
.
</syntaxhighlight>
{{out}}
<pre>
After dealing the cards the state of the stacks is:
Red : B B B R B B B R R R R R R B
Black : B B B R R B R B B R R B
Discard: R B R B B R B R R B B R R R R R R R R B B B B B R B
 
After swapping 7 cards the state of the stacks is:
Red : R R B R R B B R B R B R R B
Black : B B R B R B B B R B R B
 
The number of red cards in the red stack = 8
The number of black cards in the black stack = 8
So the asssertion is correct!
</pre>
 
Line 1,554 ⟶ 1,749:
BBBBBBBB = Black cards in the black pile
true</pre>
 
=={{header|jq}}==
'''Adapted from [[#Wren|Wren]]'''
 
'''Works with jq, the C implementation of jq'''
 
'''Works with gojq, the Go implementation of jq'''
 
Since jq does not include a PRN generator, an external source of entropy such as /dev/urandom is assumed.
A suitable invocation of jq would be along the lines of:
<pre>
< /dev/urandom tr -cd '0-9' | fold -w 1 | jq -nr trick.jq
</pre>
<syntaxhighlight lang="jq">
### Generic utilities
def count(s): reduce s as $x (0; . + 1);
 
def lpad($len): tostring | ($len - length) as $l | (" " * $l) + .;
 
 
### Pseuo-random numbers
 
# Output: a prn in range(0;$n) where $n is `.`
def prn:
if . == 1 then 0
else . as $n
| ([1, (($n-1)|tostring|length)]|max) as $w
| [limit($w; inputs)] | join("") | tonumber
| if . < $n then . else ($n | prn) end
end;
 
def sample:
if length == 0 # e.g. null or []
then null
else .[length|prn]
end;
 
def knuthShuffle:
length as $n
| if $n <= 1 then .
else {i: $n, a: .}
| until(.i == 0;
.i += -1
| (.i + 1 | prn) as $j
| .a[.i] as $t
| .a[.i] = .a[$j]
| .a[$j] = $t)
| .a
end;
 
 
### Cards
 
def R: "R"; # 82 ASCII
def B: "B"; # 66 ASCII
 
# Create deck, half red, half black and shuffle it.
def deck:
([range(0;26)|R] + [range(0;26)|B]) | knuthShuffle;
 
# Deal from `deck` into three stacks: {black, red, discard}
def deal:
deck as $deck
| reduce range(0; 51; 2) as $i (.;
if $deck[$i] == B
then .black += [$deck[$i+1]]
else .red += [$deck[$i+1]]
end
| .discard += [$deck[$i]] );
 
def proceed:
def p: join(" ");
(.red|length) as $lr
| (.black|length) as $lb
| (.discard|length) as $ld
 
| def displayStacks($discard):
" Red : \($lr|lpad(2)) cards -> \(.red|p)",
" Black : \($lb|lpad(2)) cards -> \(.black|p)",
(select($discard)
| " Discard: \($ld) cards -> \(.discard|p)") ;
 
# Input: {red, black}
def swap($n):
. + { rp: ([range(0; $lr)] | knuthShuffle[0:$n] ),
bp: ([range(0; $lb)] | knuthShuffle[0:$n]) }
| reduce range(0;$n) as $i (.;
.red[.rp[$i]] as $t
| .red[.rp[$i]] = .black[.bp[$i]]
| .black[.bp[$i]] = $t);
 
def epilog:
# Check that the number of black cards in the black stack equals
# the number of red cards in the red stack:
count(select(.red[] == R)) as $rcount
| count(select(.black[] == B)) as $bcount
| "\nThe number of red cards in the red stack = \($rcount)",
"The number of black cards in the black stack = \($bcount)",
if $rcount == $bcount
then "So the assertion is correct!"
else "So the assertion is incorrect!"
end;
 
"After dealing the cards, the stacks are as follows:",
displayStacks(true),
# Swap the same, random, number of cards between the red and black stacks.
( (if $lr < $lb then $lr else $lb end) as $min
| (($min - 1|prn) + 1) as $n
| swap($n)
| "\n\($n) card(s) are to be swapped.",
"The respective zero-based indices of the cards to be swapped are:",
" Red : \(.rp|map(lpad(3))|p)",
" Black : \(.bp|map(lpad(3))|p)",
"\nAfter swapping, the red and black stacks are as follows:",
displayStacks(false),
epilog ) ;
 
deal | proceed
</syntaxhighlight>
{{output}}
<pre>
After dealing the cards, the stacks are as follows:
Red : 12 cards -> R B R R B B B R R B R B
Black : 14 cards -> R B B R B R R R B R B R B R
Discard: 26 cards -> R R B B B R B R B R R B B B R B R B R B B B R B R R
 
1 card(s) are to be swapped.
The respective zero-based indices of the cards to be swapped are:
Red : 6
Black : 5
 
After swapping, the red and black stacks are as follows:
Red : 12 cards -> R B R R B B R R R B R B
Black : 14 cards -> R B B R B B R R B R B R B R
 
The number of red cards in the red stack = 7
The number of black cards in the black stack = 7
So the assertion is correct!
</pre>
 
=={{header|Julia}}==
34

edits