R: matrice avec flèches directionnelles
J'essaye de reproduire avec R un algorithme décrit dans Sutton et Barto (2018), mais je n'ai pas pu produire une matrice avec des flèches comme celle décrite par les auteurs à la page 65:

J'ai essayé d'utiliser le package "fields" à cet effet, mais sans grand succès.
En Python, la solution proposée par Shangtong Zhang et Kenta Shimada repose sur l'utilisation des flèches: ACTIONS_FIGS = ['←', '↑', '→', '↓'] mais cela ne fonctionne pas très bien avec R ...
EDIT: J'ai codé les actions initiales et l'action se met à jour numériquement comme suit:
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
J'ai également pu adapter le code posté ici , pour dessiner une grille simple avec de simples flèches:
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())
Cependant:
(i) Il n'y a pas d'Unicode disponible pour le nice 2 sont des flèches à 4 directions rapportées dans le tableau$\pi_\ast$ci-dessus
(ii) ... et donc je n'essayais pas de coder la bijection entre les valeurs numériques dans le tableau "action_random" et un joli tableau avec des flèches dedans ...
Tout indice permettant de résoudre les problèmes (i) et (ii) est le bienvenu.
Réponses
Voici un moyen grille + treillis pour reproduire la matrice:
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)

L'utilisation du package emojifont
fonctionne pour moi pour obtenir plus d'options Unicode. Dans votre ggplot, vous ajoutez family='EmojiOne'
. Voici un exemple utilisant l'unicode
En savoir plus sur le package emojifont ici
EDIT : Hack pour la flèche 4 directions:
Ce n'est pas la solution la plus jolie ou la plus élégante, mais vous pouvez superposer des ggplots à l'aide du package magick
pour obtenir des flèches directionnelles. Créez deux calques de tracé, un avec une flèche gauche-droite ( U+2194
) et un autre avec une flèche haut-bas ( U+2195
), puis fusionnez (merci @ Billy34 pour avoir rendu le code un peu plus élégant):
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)

METTRE À JOUR:
Tout aussi peu gracieux que le code précédent, mais plus proche de ce que vous recherchez…
Certains Unicodes ne fonctionnent qu'avec certaines polices, la première étape consiste donc à trouver les polices qui fonctionnent pour l'Unicode que vous recherchez. Voici un exemple de prise en charge des polices pour un type de flèche vers la gauche utilisé dans l'exemple ci-dessous .
Bien sûr, aucune des polices de la liste n'est standard, car la vie n'est pas si facile. La prochaine étape consiste donc à installer la police. J'ai utilisé la police Symbola que j'ai téléchargée ici . Copiez le fichier de police dans votre répertoire R ou dans votre dossier de projet si vous utilisez des projets.
Ensuite, utilisez le showtext de la bibliothèque . Le package vous permet d'utiliser des polices système dans les graphiques (nécessite un package sysfonts
). Si la police est standard dans votre système d'exploitation, je vous recommande de regarder le package systemfonts .
Dans mon exemple , je les flèches \U1F800
et \U1F801
, puis, comme dans mon exemple précédent, je les CHEVAUCHENT ( PS: vous pourriez avoir à tripoter nudge_y
et nudge_x
en geom_text
pour les faire correctement alignés) :
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')
Voici le résultat que j'ai obtenu:

Je ne peux pas dire que c'est le plus joli code jamais vu, il est aussi piraté que possible, mais cela pourrait être utile! (Cela a pris plus de temps que je ne voudrais l'admettre!)