R: Matrix mit Richtungspfeilen
Ich versuche, mit R einen in Sutton und Barto (2018) beschriebenen Algorithmus zu reproduzieren, konnte jedoch keine Matrix mit Pfeilen erstellen, wie sie von den Autoren auf Seite 65 beschrieben wurde:

Ich habe versucht, das Paket "Felder" für diesen Zweck zu verwenden, aber ohne großen Erfolg.
In Python basiert die von Shangtong Zhang und Kenta Shimada vorgeschlagene Lösung auf der Verwendung der Pfeilsymbole: ACTIONS_FIGS = ['←', '↑', '→', '↓'], aber dies funktioniert nicht gut mit R ...
BEARBEITEN: Ich habe die anfänglichen Aktionen und die Aktionsaktualisierungen wie folgt numerisch codiert:
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
Ich war auch in der Lage , den Code geschrieben anzupassen hier , ein einfaches Gitter mit einfachen Pfeilen zu zeichnen:
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())
Allerdings:
(i) Es ist kein Unicode für die in Tabelle 2 angegebenen schönen Pfeile mit 2 Richtungen und 4 Richtungen verfügbar$\pi_\ast$oben
(ii) ... und so habe ich nicht versucht, die Bijektion zwischen den numerischen Werten in der Tabelle "action_random" und einer schönen Tabelle mit Pfeilen darin zu codieren ...
Jeder Hinweis zur Lösung der Probleme (i) und (ii) ist willkommen.
Antworten
Hier ist ein Gitter + Gitter-Weg, um die Matrix zu reproduzieren:
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)

Die Verwendung des Pakets emojifont
funktioniert für mich, um mehr Unicode-Optionen zu erhalten. In Ihrem ggplot fügen Sie hinzu family='EmojiOne'
. Hier ist ein Beispiel mit dem Unicode
Mehr zum Paket Emojifont hier
EDIT : Hack für 4-Richtungspfeil:
Nicht die schönste oder eleganteste Lösung, aber Sie können ggplots mit dem Paket überlagern magick
, um Richtungspfeile zu erhalten. Erstellen Sie zwei Plotebenen, eine mit dem Links-Rechts-Pfeil ( U+2194
) und eine mit dem Auf-Ab-Pfeil ( U+2195
), und führen Sie sie dann zusammen (danke @ Billy34, dass Sie den Code etwas eleganter gestaltet haben):
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)

AKTUALISIEREN:
Genauso ungnädig wie der vorherige Code, aber näher an dem, wonach Sie suchen ...
Bestimmte Unicodes funktionieren nur mit bestimmten Schriftarten. Der erste Schritt besteht darin, herauszufinden, welche Schriftarten für den gewünschten Unicode geeignet sind. Hier ist ein Beispiel für die Unterstützung von Schriftarten für einen Pfeil nach links, der im folgenden Beispiel verwendet wird .
Natürlich ist keine der Schriftarten auf der Liste Standard, weil das Leben nicht so einfach ist. Der nächste Schritt ist also die Installation der Schriftart. Ich habe die Schriftart Symbola verwendet , die ich hier heruntergeladen habe . Kopieren Sie die Schriftartdatei in Ihr R-Verzeichnis oder in Ihren Projektordner, wenn Sie Projekte verwenden.
Verwenden Sie dann den Showtext der Bibliothek . Mit dem Paket können Sie Systemschriftarten in Grafiken verwenden (erfordert Paket sysfonts
). Wenn die Schriftart in Ihrem Betriebssystem Standard ist, empfehlen wir Ihnen, sich die Systemschriftarten des Pakets anzusehen .
In meinem Beispiel habe ich die Pfeile verwendet \U1F800
und sie \U1F801
dann, wie in meinem vorherigen Beispiel, überlappt ( PS: Möglicherweise müssen Sie mit nudge_y
und nudge_x
in geom_text
herumalbern, um sie richtig auszurichten) :
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')
Hier ist das Ergebnis, das ich bekommen habe:

Ich kann nicht sagen, dass dies der schönste Code ist, der jemals gesehen wurde. Es ist so hackig wie es nur geht, aber es könnte hilfreich sein! (Es hat mehr Zeit gedauert, als ich zugeben möchte!)