R: matriz con flechas direccionales
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
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)
Usar el paquete emojifont
me 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 magick
para 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 \U1F800
y \U1F801
, a continuación, al igual que en mi ejemplo anterior, les superpuesto ( PD: puede que tenga que perder el tiempo con nudge_y
y nudge_x
en el geom_text
que 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!)