R: matriz con flechas direccionales

Jan 03 2021

Estoy intentando reproducir con R un algoritmo descrito en Sutton y Barto (2018), pero no pude producir una matriz con flechas como la descrita por los autores en la página 65:

Traté de usar el paquete "campos" para este propósito, pero sin mucho éxito.

En Python, la solución propuesta por Shangtong Zhang y Kenta Shimada se basa en el uso de los símbolos de flechas: ACTIONS_FIGS = ['←', '↑', '→', '↓'] pero esto no funciona bien con R ...

EDITAR: Codifiqué las acciones iniciales y la acción se actualiza numéricamente de la siguiente manera:

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

También pude adaptar el código publicado aquí , para dibujar una cuadrícula simple con flechas 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())

Sin embargo:
(i) No hay unicode disponible para el nice 2 son flechas de 4 direcciones que se muestran en la Tabla$\pi_\ast$arriba
(ii) ... por lo que no estaba tratando de codificar la biyección entre los valores numéricos en la Tabla "action_random" y una bonita Tabla con flechas en ella ...

Cualquier sugerencia que ayude a resolver los problemas (i) y (ii) es bienvenida.

Respuestas

1 AbdurRohman Jan 21 2021 at 22:01

Aquí hay una forma de cuadrícula + celosía para reproducir la 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)

5 ViviG Jan 14 2021 at 21:33

Usar el paquete emojifontme funciona para obtener más opciones Unicode. En su ggplot agrega family='EmojiOne'. Aquí hay un ejemplo usando el unicode

Más sobre el paquete emojifont aquí

EDITAR : Hack para flecha de 4 direcciones:

No es la solución más bonita o elegante, pero puede superponer ggplots usando el paquete magickpara obtener flechas direccionales. Haga dos capas de trama, una con la flecha izquierda-derecha ( U+2194) y otra con la flecha arriba-abajo ( U+2195), luego combine luego (gracias @ Billy34 por hacer que el código sea un poco más 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)

ACTUALIZAR:

Tan descortés como el código anterior, pero más cercano a lo que está buscando ...

Ciertos Unicodes funcionan solo con ciertas fuentes, por lo que el primer paso es encontrar qué fuentes funcionan para el Unicode que está buscando. A continuación, se muestra un ejemplo de compatibilidad con fuentes para un tipo de flecha hacia la izquierda que se utiliza en el siguiente ejemplo .

Por supuesto, ninguna de las fuentes de la lista es estándar, porque la vida no es tan fácil. Entonces, el siguiente paso es instalar la fuente. Usé la fuente Symbola que descargué aquí . Copie el archivo de fuente en su directorio R o en la carpeta de su proyecto si está utilizando proyectos.

Luego use el showtext de la biblioteca . El paquete le permite utilizar fuentes del sistema en gráficos (requiere paquete sysfonts). Si la fuente es estándar en su sistema operativo, le recomiendo que mire el paquete systemfonts .

En mi ejemplo he utilizado las flechas \U1F800y \U1F801, a continuación, al igual que en mi ejemplo anterior, les superpuesto ( PD: puede que tenga que perder el tiempo con nudge_yy nudge_xen el geom_textque quedan correctamente alineados) :

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

Aquí está el resultado que obtuve:

No puedo decir que este sea el código más bonito jamás visto, es lo más hack posible, ¡pero podría ser útil! (¡Me tomó más tiempo hacer esto de lo que me gustaría admitir!)