How to plot a RoadMap (like one for Baccarat)?

Question

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

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?

Answer 1

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]