Randomness

and application to a MATh.en.JEANS research workshop theme

March 14, 2025 - Yves Papegay - yap@informathiques.fr

This notebook is the preliminary version of the support of the fifth session of the course “Online teacher training and community of practices - Digital tools for STEAM education and Makers pedagogy, November 2024 - June 2025” , an activity of the “MEJ MAKERS ERASMUS+ project (2023-2-FR01-KA210-SCH-000176068)” - visit the course dedicated web page for details.

Randomness

Random number generation in Wolfram Language is a versatile tool used to produce random numbers from different distributions and sets.

Here are some key functions and examples:

RandomReal[{0,1}]  (* Generates a random real number between 0 and 1 *)

RandomInteger[{1,10}]  (* Generates a random integer between 1 and 10 *)

RandomChoice[{"apple","banana","cherry"}]  (* Randomly selects one fruit from the list *)

RandomSample[Range[10],3]  (* Selects 3 random numbers from the list {1, 2, ..., 10} *)

RandomVariate[NormalDistribution[0,1],5]  (* Generates 5 random numbers from a normal distribution with mean 0 and standard deviation 1 *)

Reproductibility

Additionally, the function (TextRefLink[SeedRandom, paclet:ref/SeedRandom, https://reference.wolfram.com/language/ref/SeedRandom.html]) is used to set the seed for the random number generator, ensuring reproducibility of results.

For example, using the same seed will produce the same sequence of random numbers:

SeedRandom[1234];Table[RandomReal[],3]

SeedRandom[1234];Table[RandomReal[],3]

Pseudo-Randomness

"Congruential" method for generating pseudo-random sequences uses a linear congruential generator. This is one of the simplest types of pseudorandom number generators, with pseudorandom numbers between 0 and 1 obtained from (Subscript[x, i])/m, where (Subscript[x, i]) is given by the modular recurrence relation

(Subscript[x, i])≡(b (Subscript[x, i-1])+c) mod m

for some fixed integers b, c, and m called the multiplier, increment, and modulus, respectively.

BlockRandom[SeedRandom[1,Method->{"Congruential","Multiplier"->11,"Increment"->0,"Modulus"->63}];RandomReal[1,40]]

The actual period can be determined by finding the smallest integer i such that i≡(b^i)  mod m.

First[Select[Range[EulerPhi[63]],(Mod[11^#,63]===1&)]]

BlockRandom[SeedRandom[1,Method->{"Congruential","Multiplier"->1283839219676404755,"Increment"->0,"Modulus"->2305843009213693951}];Histogram[RandomReal[1,100000]]]

ListPlot[RandomReal[1,500]]

More details in this technical note.

Magic Cards

A simulation to understand

Visualisation of cards

Suits

Playing cards are of 4 different suits (spades, diamonds, hearts and clubs).

suits={"♠",Style["♢",Red,Bold],Style["♡",Red,Bold],"♣"}

Cards

The function card below creates a graphics visualisation of a card, based on its suits and value. Complete it to represent also cards between 3 and 6.

Clear[card]
card[s_,1]:=Graphics[{Line[{{-6,-9},{6,-9},{6,9},{-6,9},{-6,-9}}],Text[Style[s,12]]},ImageSize->30]
card[s_,2]:=Graphics[{Line[{{-6,-9},{6,-9},{6,9},{-6,9},{-6,-9}}],Text[Style[s,12],{0,5}],Text[Style[s,12],{0,-5}]},ImageSize->30]
card[s_,3]:=Graphics[{Line[{{-6,-9},{6,-9},{6,9},{-6,9},{-6,-9}}],Text[Style[s,12],{0,5}],Text[Style[s,12],{0,0}],Text[Style[s,12],{0,-5}]},ImageSize->30]
card[s_,4]:=Graphics[{Line[{{-6,-9},{6,-9},{6,9},{-6,9},{-6,-9}}],Text[Style[s,12],{-3,5}],Text[Style[s,12],{-3,-5}],Text[Style[s,12],{3,5}],Text[Style[s,12],{3,-5}]},ImageSize->30]
card[s_,5]:=Graphics[{Line[{{-6,-9},{6,-9},{6,9},{-6,9},{-6,-9}}],Text[Style[s,12],{-3,5}],Text[Style[s,12],{-3,-5}],Text[Style[s,12],{0,0}],Text[Style[s,12],{3,5}],Text[Style[s,12],{3,-5}]},ImageSize->30]
card[s_,6]:=Graphics[{Line[{{-6,-9},{6,-9},{6,9},{-6,9},{-6,-9}}],Text[Style[s,12],{-3,5}],Text[Style[s,12],{-3,-5}],Text[Style[s,12],{-3,0}],Text[Style[s,12],{3,0}],Text[Style[s,12],{3,5}],Text[Style[s,12],{3,-5}]},ImageSize->30]

{card[suits[[2]],1],card[suits[[4]],2]}

Pack

Let’s define the pack of 24 cards.

pack=Flatten[Outer[card,suits,Range[6]]]

Developping the trick

Randomly shuffle the pack

deal=RandomSample[pack]

Visualize the board

Circle is an easy and interesting way of representing the deal, we assume that the first card is the leftest one (3 o’clock) and following counter-clockwise order.The pink area give the six first cards.
Let’s define a first version of the boardView function that visualize the deal.

Clear[boardView]
boardView[d_]:=Graphics[{{LightPink,Disk[{0,0},24,{-Pi/24,11Pi/24}]},Table[Inset[d[[i]],21{Cos[i Pi/12-2Pi/24],Sin[i Pi/12-2Pi/24]},{0,0},3],{i,1,Length[d]}]},PlotRange->{-27,27},ImageSize->500]

boardView[deal]

Selecting a card

Ask player to select any card amongst the first 6

firstCard=RandomInteger[{1,6}]

Add a graphical way to show the selected card, by enhancing boardView.

boardView[d_,r_]:=Graphics[{{LightPink,Disk[{0,0},24,{-Pi/24,11Pi/24}]},Table[Inset[d[[i]],21{Cos[i Pi/12-2Pi/24],Sin[i Pi/12-2Pi/24]},{0,0},3],{i,1,Length[d]}],Line[{{0,0},18{Cos[(r-1) Pi/12],Sin[(r-1) Pi/12]}}],PointSize[0.02],Point[18{Cos[(r-1) Pi/12],Sin[(r-1) Pi/12]}]},PlotRange->{-27,27},ImageSize->500]

boardView[deal,4]

Propagate one step

Rank of the next card is given by adding the value of the current card to its rank. Let’s define the nextCard function that computes this rank.

deal[[4,1]]//FullForm

nextCard[d_,r_]:=r+Count[d[[r,1]],_Text]

nextCard[deal,firstCard]

Add a graphical way to show the selected cards, by enhancing boardView.

boardView[d_,rl_List]:=Graphics[{{LightPink,Disk[{0,0},24,{-Pi/24,11Pi/24}]},Table[Inset[d[[i]],21{Cos[i Pi/12-2Pi/24],Sin[i Pi/12-2Pi/24]},{0,0},3],{i,1,Length[d]}],Line[Prepend[Map[18{Cos[# Pi/12-2Pi/24],Sin[# Pi/12-2Pi/24]}&,rl],{0,0}]],PointSize[0.02],Point[Map[18{Cos[(#-1) Pi/12],Sin[(#-1) Pi/12]}&,rl]]},PlotRange->{-27,27},ImageSize->500]

boardView[deal,{firstCard, nextCard[deal,firstCard]}]

Propagate until being back in the pink area

We get the list of visited cards by iterating the nextCard function until reaching the end of the deal.

listCards[d_,fr_]:=Map[Mod[#,Length[d]]&,NestWhileList[nextCard[d,#]&,fr,#<=Length[d]&]]

listCards[deal,4]

boardView[deal,listCards[deal,4]]

As a magician, you can predict what will be this last card, giving the feeling to the audience that you have guessed the first selected card. That is the trick.

Why the trick works ?

Let’s see what happens when changing the first card...

Manipulate[boardView[deal,listCards[deal,i]],{i,Range[6]},ControlType->SetterBar]

Is the trick always working ?

The trick is working if and only if the set of last reached cards is reduced to one element.

For such an analyse, we don’t need any visualisation but we need to be as fast as possible in order to perform a lot of computations. Hence, we will focus on ranks.

Let’s write a function giving the set of last reached card ranks for a given deal and all the possible choices as input.

Table[Last[listCards[deal,i]],{i,1,6}]

lastCards[d_]:=Union[Table[Last[listCards[d,i]],{i,1,6}]]

lastCards[deal]

Is it always true ?

Let’s try 100 times.

res100 =Table[(sdeal[i]=RandomSample[pack];lastCards[sdeal[i]]),{i,1,100,1}]

Some deal lead to several cards, even if most of them lead to only one.

Tally[Map[Length,res100]]

Let’s have a look at one of such cases :

Position[res100,{_,_}]

Manipulate[boardView[deal,listCards[sdeal[17],i]],{i,Range[6]},ControlType->SetterBar]

On essaie 100.000 pour avoir une idée de la probabilité de réussite.

Tally[Table[With[{deal=RandomSample[pack]},Length[lastCards[deal]]],{100000}]]

Tally[Table[With[{deal=RandomSample[pack]},Length[lastCards[deal]]],{1000000}]]

Because shuffling card is done uniformly, we can estimate the probability of being sure that the trick is working around 80%.

echantillon=Reverse[SortBy[Tally[Map[With[{deal=RandomSample[pack]},Map[Last,Tally[Map[listCards[deal,#]&,Range[6]]]]]&,Range[1000]]],Last]]

But we can look further into the rresult tto evaluate more precisely the chance of being “magic”...

res=Reverse[SortBy[Tally[Table[With[{deal=RandomSample[pack]},Map[Last,Tally[Map[Last[listCards[deal,#]]&,Range[6]]]]],{10000}]],Last]]

Total[Map[Max[#[[1]]]/6. #[[2]]&,res]]/10000

Let’s repeat the experience 10 times

Table[With[{res=Reverse[SortBy[Tally[Table[With[{deal=RandomSample[pack]},Map[Last,Tally[Map[Last[listCards[deal,#]]&,Range[6]]]]],{10000}]],Last]]},Total[Map[Max[#[[1]]]/6. #[[2]]&,res]]/10000],{10}]