R: matriz com setas direcionais

Question

Estou tentando reproduzir com R um algoritmo descrito em Sutton e Barto (2018), mas não fui capaz de produzir uma matriz com setas como a descrita pelos autores na página 65:

Tentei usar o pacote "fields" para esse fim, mas sem muito sucesso.

Em Python, a solução proposta por Shangtong Zhang e Kenta Shimada depende do uso dos símbolos de setas: ACTIONS_FIGS = ['←', '↑', '→', '↓'] mas isso não funciona bem com R ...

EDITAR: codifiquei as ações iniciais e as atualizações de ação numericamente da seguinte forma:

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

Também consegui adaptar o código postado aqui , para desenhar uma grade simples com setas simples:

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())

No entanto:
(i) Não há unicode disponível para o bom 2 são setas 4-direcionais relatadas na Tabela$\pi_\ast$acima
(ii) ... e então eu não estava tentando codificar a bijeção entre os valores numéricos na tabela "action_random" e uma bela tabela com setas nela ...

Qualquer sugestão que ajude a resolver os problemas (i) e (ii) é bem-vinda.

Answer 1

Aqui está uma forma de grade + rede para reproduzir a matriz:

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)

Answer 2

Usar o pacote emojifontfunciona para mim para obter mais opções de Unicode. Em seu ggplot, você adiciona family='EmojiOne'. Aqui está um exemplo usando o Unicode

Mais sobre o pacote emojifont aqui

EDIT : Hack para seta 4 direcional:

Não é a solução mais bonita ou mais elegante, mas você pode sobrepor ggplots usando o pacote magickpara obter setas direcionais. Faça duas camadas de plotagem, uma com a seta da esquerda para a direita ( U+2194) e outra com a seta para cima e para baixo ( U+2195) e depois mescle (obrigado @ Billy34 por tornar o código um pouco mais elegante):

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)

ATUALIZAR:

Tão indelicado quanto o código anterior, mas mais próximo do que você está procurando ...

Certos Unicodes funcionam apenas com certas fontes, portanto, a primeira etapa é descobrir quais fontes funcionam para o Unicode que você está procurando. Aqui está um exemplo de suporte de fonte para um tipo de seta para a esquerda usado no exemplo abaixo .

Claro, nenhuma das fontes da lista é padrão, porque a vida não é tão fácil. Portanto, a próxima etapa é instalar a fonte. Usei a fonte Symbola que baixei aqui . Copie o arquivo de fonte para o diretório R ou para a pasta do projeto se estiver usando projetos.

Em seguida, use o showtext da biblioteca . O pacote permite que você use fontes do sistema em gráficos (requer pacote sysfonts). Se a fonte for padrão em seu sistema operacional, eu recomendo que você olhe o pacote systemfonts .

No meu exemplo, usei as setas \U1F800e \U1F801, em seguida, como no exemplo anterior, eu as sobrepus ( PS: você pode ter que brincar com nudge_ye nudge_xdentro geom_textpara alinhá-las corretamente) :

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')

Aqui está o resultado que obtive:

Não posso dizer que este é o código mais bonito já visto, é o mais hack possível, mas pode ser útil! (Demorou mais tempo para fazer isso do que eu gostaria de admitir!)