2

I am trying to reproduce with R an algorithm described in Sutton and Barto (2018), but I was not able to produce a matrix with arrows as the one described by the authors on page 65:

enter image description here

I tried to use the package "fields" for this purpose, but without much success.

In Python the solution proposed by Shangtong Zhang and Kenta Shimada relies on using the arrows symbols: ACTIONS_FIGS=[ '←', '↑', '→', '↓'] but this does not work nicely with R...

EDIT: I coded the initial actions and the action updates numerically as follows:

library(data.table)
action_random = data.table(cell=c(1:25))
action_random$action_up = action_random$action_right = action_random$action_down =
action_random$action_left = rep(1,25)
action_random$proba = rep(1/4,25)
action_random

I was also able to adapt the code posted here, to draw a simple grid with simple arrows:

arrows = matrix(c("\U2190","\U2191","\U2192","\U2193"),nrow=2,ncol=2)
grid_arrows = expand.grid(x=1:ncol(arrows),y=1:nrow(arrows))
grid_arrows$val = arrows[as.matrix(grid_arrows[c('y','x')])]

library(ggplot2)

ggplot(grid_arrows, aes(x=x, y=y, label=val)) + 
  geom_tile(fill='transparent', colour = 'black') + 
  geom_text(size = 14) + 
  scale_y_reverse() +
  theme_classic() + 
  theme(axis.text  = element_blank(),
        panel.grid = element_blank(),
        axis.line  = element_blank(),
        axis.ticks = element_blank(),
        axis.title = element_blank())

However:
(i) There is no unicode available for the nice 2 are 4-directional arrows reported in Table $\pi_\ast$ above
(ii) ... and so I was not trying to code the bijection between the numerical values in the Table "action_random" and a nice Table with arrows in it...

Any hint helping to resolve issues (i) and (ii) are welcome.

Bertrand
  • 75
  • 8

2 Answers2

7

Using the package emojifont works for me to get more unicode options. In your ggplot you add family='EmojiOne'. Here is an example using the unicode

More about the package emojifont here

EDIT: Hack for 4-directional arrow:

Not the prettiest or more elegant solution, but you can overlay ggplots using the package magick to get directional arrows. Make two plot layers, one with left-right arrow (U+2194) and another with up-down arrow (U+2195), then merge then (thanks @Billy34 for making the code a bit more elegant):

library(data.table)
library(magick)

library(ggplot2)
library(emojifont)

#layer 1
arrows1 = matrix(c("\U21B4","\U2195","\U2192","\U2193"),nrow=2,ncol=2)
grid_arrows1 = expand.grid(x=1:ncol(arrows1),y=1:nrow(arrows1))
grid_arrows1$val = arrows1[as.matrix(grid_arrows1[c('y','x')])]

#layer 2
arrows2 = matrix(c("\U21B4","\U2194","\U2192","\U2193"),nrow=2,ncol=2)
grid_arrows2 = expand.grid(x1=1:ncol(arrows2),y1=1:nrow(arrows2))
grid_arrows2$val = arrows2[as.matrix(grid_arrows2[c('y1','x1')])]

ggplot(grid_arrows1, aes(x=x, y=y, label=val),family='EmojiOne') + 
  geom_tile(fill='NA', colour = 'black') + 
  
  geom_text(size = 18) + 
  
  geom_text(grid_arrows2,mapping =  aes(x=x1, y=y1, label=val),size = 18) +
  scale_y_reverse() +
  theme_classic() + 
  theme(
        panel.background = element_rect(fill = "transparent"), # bg of the panel
    plot.background = element_rect(fill = "transparent", color = NA), # bg of the plot
axis.text  = element_blank(),
        panel.grid = element_blank(),
        axis.line  = element_blank(),
        axis.ticks = element_blank(),
        axis.title = element_blank()# get rid of legend panel bg
  ) 
  
#save plot as image
ggsave(filename = 'plot1.png', device = 'png', bg = 'transparent') 


# read images with package magick
 plot1 <- image_read('plot1.png')

image_mosaic(plot1)

enter image description here

UPDATE:

Just as ungracious as the previous code, but closer to what you are looking for…

Certain Unicodes work only with certain fonts, so the first step is to find which fonts work for the Unicode you are looking for. Here is an example of font support for a type of leftwards arrow used in the example below.

Of course, none of the fonts on the list is standard, because life is not that easy. So the next step is install the font. I used font Symbola that I downloaded here. Copy the font file to your R directory or to your project folder if you are using projects.

Then use the library showtext. The package allow you to use system fonts in graphics (requires package sysfonts). If the font is standard in your OS I recommend you look at the package systemfonts.

In my example I used the arrows \U1F800 and \U1F801, then, like in my previous example, I overlapped them (PS: you might have to fool around with nudge_y and nudge_x in geom_text to get them properly aligned) :

library(data.table)
library(magick)
library(ggplot2)
library(showtext)



#layer 1, upwards arrow
arrows1 = matrix(c("", "\U1F801", "\U1F801", ""),
                 nrow = 2,
                 ncol = 2)
grid_arrows1 = expand.grid(x = 1:ncol(arrows1), y = 1:nrow(arrows1))
grid_arrows1$val = arrows1[as.matrix(grid_arrows1[c('y', 'x')])]

#layer 2 , leftwards arrow
arrows2 = matrix(c("", "\U1F800", "\U1F800", ""),
                 nrow = 2,
                 ncol = 2)
grid_arrows2 = expand.grid(x1 = 1:ncol(arrows2), y1 = 1:nrow(arrows2))
grid_arrows2$val = arrows2[as.matrix(grid_arrows2[c('y1', 'x1')])]

#layer 3 , upwards arrow
arrows3  = matrix(c("\U1F801", "", "", "\U1F801"),
                  nrow = 2,
                  ncol = 2)
grid_arrows3 = expand.grid(x2 = 1:ncol(arrows3), y2 = 1:nrow(arrows3))
grid_arrows3$val = arrows3[as.matrix(grid_arrows3[c('y2', 'x2')])]

#layer 4 , leftwards arrow
arrows4 = matrix(c("\U1F800", "", "", "\U1F800"),
                 nrow = 2,
                 ncol = 2)
grid_arrows4 = expand.grid(x3 = 1:ncol(arrows4), y3 = 1:nrow(arrows4))
grid_arrows4$val = arrows4[as.matrix(grid_arrows4[c('y3', 'x3')])]

#use function font_add from lybrary showtext
 font_add("Symbola", regular = "Symbola_hint.ttf")
# Take a look at the function showtext_auto() as well

 ggplot(grid_arrows1,
        aes(x = x, y = y, label = val),
        family = 'Symbola',
        size = 18) +
   
   geom_tile(fill = 'NA', colour = 'black') +
   geom_text(
     grid_arrows1,
     mapping = aes(x = x, y = y, label = val),
     family = 'Symbola',
     size = 18
   ) +
   
   geom_text(
     grid_arrows2,
     mapping =  aes(x = x1, y = y1, label = val),
     family = 'Symbola',
     size = 18,
     nudge_x = -0.01
   ) +
   geom_text(
     grid_arrows1,
     mapping =  aes(x = x, y = y, label = val),
     family = 'Symbola',
     size = 18,
     angle = 180
   ) +
   geom_text(
     grid_arrows2,
     mapping =  aes(x = x1, y = y1, label = val),
     family = 'Symbola',
     size = 18,
     angle = 180,
     nudge_x = 0.01,
     nudge_y = 0.007
   ) +
   geom_text(
     grid_arrows3,
     mapping =  aes(x = x2, y = y2, label = val),
     family = 'Symbola',
     size = 17,
     nudge_y = 0.03
   ) +
   geom_text(
     grid_arrows4,
     mapping =  aes(x = x3, y = y3, label = val),
     family = 'Symbola',
     size = 17,
     nudge_x = -0.021,
     nudge_y = -0.01
   ) +
   
   scale_y_reverse() +
   theme_classic() +
   theme(
     panel.background = element_rect(fill = "transparent"),
     # bg of the panel
     plot.background = element_rect(fill = "transparent", color = NA),
     # bg of the plot
     axis.text  = element_blank(),
     panel.grid = element_blank(),
     axis.line  = element_blank(),
     axis.ticks = element_blank(),
     axis.title = element_blank()# get rid of legend panel bg
   ) 
 
 #save plot as image
 ggsave(filename = 'plot.png',
        device = 'png',
        bg = 'transparent')
 
 # read images with package magick
 image_read('plot.png')

Here is the result I got:

enter image description here

I cannot say this is the prettiest code ever seen, it is as hack as it gets, but it might be helpful! (It took more time to get this done than I would like to admit!)

ViviG
  • 1,613
  • 1
  • 9
  • 23
  • 1
    Isn't it easier to overlay two geom_text layer instead of merging to images ? – Billy34 Jan 14 '21 at 19:06
  • 1
    You are absolutely right, @Billy34. I got an error earlier and didn't have the time to figure out why it was not working. But now I have edited it. Thanks! – ViviG Jan 14 '21 at 21:01
  • Thank you for you input, it is interesting indeed. However, the orthogonal arrows obtained by overlaying a horizontal and a vertical unicode arrow are not as beautiful as the original ones. I have tried with tikz, which is very flexible to draw the set of $2^4-1$ directions, but was not able to import the tikz-arrows in R. – Bertrand Jan 16 '21 at 15:07
  • True, @Bertrand. I tried another approach. Still super "hacky" though... – ViviG Jan 17 '21 at 15:09
  • Did you try to use the package `tikzDevice`? https://github.com/daqana/tikzDevice – ViviG Jan 20 '21 at 09:54
  • @ViviG: yes I used tikzDevice from time to time, it is helpful to add latex labels to R plots and figures, but was not able to use this package to import arrows drawn with latex... – Bertrand Jan 20 '21 at 14:17
  • @ViviG: I include some latex-arrows below, in case this helps... \begin{tikzpicture}[scale=0.3] \draw [->] (0,0) -- (0,1); \draw [->] (0,0) -- (1,0); \end{tikzpicture} \begin{tikzpicture}[scale=0.3] \draw [<-] (-1,0) -- (0,0); \draw [<-] (0,-1) -- (0,0); \end{tikzpicture} \begin{tikzpicture}[scale=0.3] \draw [->] (0,0) -- (0,1); \draw [<-] (-1,0) -- (0,0); \draw [->] (0,0) -- (1,0); \draw [<-] (0,-1) -- (0,0); \end{tikzpicture} – Bertrand Jan 20 '21 at 14:18
2

Here is a grid+lattice way to reproduce the matrix:

library(grid)
library(lattice)

grid.newpage()
pushViewport(viewport(width = 0.8, height = 0.8)) 
grid.rect(width = 1, height = 1)
panel.grid(h = 4, v = 4)

direct = function(xCenter, yCenter, type){
  
  d= 0.05
  
  north = function(xCenter, yCenter){ 
    grid.curve(xCenter, yCenter-d ,xCenter, yCenter+d, 
               ncp = 1, angle = 90, gp=gpar(lwd=1, fill="black"),
               inflect = FALSE, shape = 0,
               arrow = arrow(type="closed", ends = "last", 
                      angle = 30, length = unit(0.2, "cm")))}
  
  west = function(xCenter, yCenter){
    grid.curve(xCenter+d, yCenter ,xCenter-d, yCenter, 
               ncp = 1, angle = 90, gp=gpar(lwd=1, fill="black"),
               inflect = FALSE, shape = 0,
               arrow = arrow(type="closed", ends = "last", 
                             angle = 30, length = unit(0.2, "cm")))}
  east = function(xCenter, yCenter){
    grid.curve(xCenter+d, yCenter ,xCenter-d, yCenter, 
               ncp = 1, angle = 90, gp=gpar(lwd=1, fill="black"),
               inflect = FALSE, shape = 0,
               arrow = arrow(type="closed", ends = "first", 
                             angle = 30, length = unit(0.2, "cm")))}
  
  northeast = function(xCenter, yCenter){
       grid.curve(xCenter-d, yCenter+d ,xCenter+d, yCenter-d, 
                 ncp = 1, angle = 90, gp=gpar(lwd=1, fill="black"),
                 inflect = FALSE, shape = 0,
                 arrow = arrow(type="closed", ends = "both", 
                         angle = 30, length = unit(0.2, "cm")))}
  
  northwest = function(xCenter, yCenter){
       grid.curve(xCenter-d, yCenter-d ,xCenter+d, yCenter+d, 
               ncp = 1, angle = 90, gp=gpar(lwd=1, fill="black"),
               inflect = FALSE, shape = 0,
               arrow = arrow(type="closed", ends = "both", 
                             angle = 30, length = unit(0.2, "cm")))}
  all = function(xCenter, yCenter){
      grid.curve(xCenter+d, yCenter ,xCenter-d, yCenter, 
                 ncp = 1, angle = 90, gp=gpar(lwd=1, fill="black"),
                 inflect = FALSE, shape = 0,
                 arrow = arrow(type="closed", ends = "both", 
                               angle = 30, length = unit(0.2, "cm")))
      grid.curve(xCenter, yCenter-d ,xCenter, yCenter+d, 
             ncp = 1, angle = 90, gp=gpar(lwd=1, fill="black"),
             inflect = FALSE, shape = 0,
             arrow = arrow(type="closed", ends = "both", 
                           angle = 30, length = unit(0.2, "cm")))}
  switch(type,
         'n' = north(xCenter, yCenter),
         'e' = east(xCenter, yCenter),
         'w' = west(xCenter, yCenter),
         'nw'= northwest(xCenter, yCenter),
         'ne' = northeast(xCenter, yCenter),
         'all' = all(xCenter, yCenter)
         )
}

x = seq(0.1, 0.9, by = 0.2)
y = x
centers = expand.grid(x0 = x, y0 = y)

row1 = row2 = row3 = c('ne','n', rep('nw',3))
row4 = c('ne','n','nw','w','w')
row5 = c('e','all','w','all','w')

dir = c(row1,row2,row3,row4,row5)
df = data.frame(centers, dir)

for (k in 1:nrow(df)) direct(df$x0[k], df$y0[k], df$dir[k])
grid.text(bquote(~pi["*"]), y = -0.05)

enter image description here

Abdur Rohman
  • 2,691
  • 2
  • 7
  • 12
  • Very nice grid. Thank you for your post which also allows me to discover the grid package. – Bertrand Jan 21 '21 at 16:05
  • Glad if it helps. The {grid} and {lattice} packages are among base R packages, included in every release of R installer so you don't need to install them manually using 'install.packages()' – Abdur Rohman Jan 21 '21 at 16:18