0
$\begingroup$

I am running simulations for the game Baccarat. I am wondering if there is a way to plot the "roads", like on this website:

enter image description here

For example, I'd like to plot the following list:

list = {"B", "B", "B", "B", "P", "T", "B", "B", "P", "B", "P", "B", "P","P", "P", "P", "P", "T", "T", "P", "P", "P"}

The rules for generating a road are the following:

  • The road starts at the top left corner
  • A "B" should be represented by a blue circle
  • A "P" should be represented by a red circle
  • If the previous letter was a "B" and the new letter is "P", or vice-versa, we start anew at the top of a new column. Otherwise, we stack circles in a path going downwards along its column.
  • If the path reaches the sixth row then it changes direction and starts moving to the right instead of downwards.
  • A "T" should not add any circle to the path but should be marked by a green line on the most recently added circle.

The blue dots and yellow circles have to do with other aspects of the game which are not reflected in the list, so they can be ignored for the purpose of this question.

Is there an easy way to plot such trace?

$\endgroup$
1
  • 4
    $\begingroup$ Can you explain the relationship between the elements of the list and the circles in the picture? $\endgroup$
    – bill s
    Oct 28, 2017 at 22:28

1 Answer 1

2
$\begingroup$

There are some problems with this answer with paths that reach the sixth row, I'll let it remain here though in case someone may be inspired by it.

The following code gives us a representation of the road:

step[h_[x_, y_, ties_]] := If[y < 6, h[x, y + 1, 0], h[x + 1, y, 0]]
tie[h_[x_, y_, ties_]] := h[x, y, ties + 1]
new["B"[x_, y_, ties_]] := "P"[x + 1, 1, 0]
new["P"[x_, y_, ties_]] := "B"[x + 1, 1, 0]

init[h_String] := h[1, 1, 0]
next[state : h_[_, _, _], in_] := Switch[in,
  h, step[state],
  "T", tie[state],
  _, new[state]
  ]

road = FoldList[next, init@First@list, Rest@list]

{"B"[1, 1, 0], "B"[1, 2, 0], "B"[1, 3, 0], "B"[1, 4, 0], "P"[2, 1, 0], "P"[2, 1, 1], "B"[3, 1, 0], "B"[3, 2, 0], "P"[4, 1, 0], "B"[5, 1, 0], "P"[6, 1, 0], "B"[7, 1, 0], "P"[8, 1, 0], "P"[8, 2, 0], "P"[8, 3, 0], "P"[8, 4, 0], "P"[8, 5, 0], "P"[8, 5, 1], "P"[8, 5, 2], "P"[8, 6, 0], "P"[9, 6, 0], "P"[10, 6, 0]}

Which we can then plot using:

circle[x_, y_] := {Thickness[0.01], Circle[{x, -y}, 0.4]}
tieMark[x_, y_] := {
  Darker@Green, Thickness[0.01],
  Line[{
    {x, -y} + 0.25 {Cos[Pi/4], Sin[Pi/4]},
    {x, -y} + 0.5 {Cos[Pi/4], Sin[Pi/4]}
    }]
  }

draw["B"[x_, y_, 0]] := {Darker@Red, circle[x, y]}
draw["B"[x_, y_, _]] := {Darker@Red, circle[x, y], tieMark[x, y]}

draw["P"[x_, y_, 0]] := {Darker@Blue, circle[x, y]}
draw["P"[x_, y_, _]] := {Darker@Blue, circle[x, y], tieMark[x, y]}

Graphics[draw /@ road]

Mathematica graphics

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.