R：带方向箭头的矩阵

我试图用R重现Sutton和Barto 2018中描述的算法，但我无法生成一个带有箭头的矩阵，正如作者在第65页所述：

我尝试使用package字段来实现这一目的，但没有多大成功

在Python中，由Shangtong Zhang和Kenta Shimada提出的解决方案 依赖于使用箭头符号： 动作_图=['←', '↑', '→', '↓'] 但这并不能很好地与R

编辑：我对初始动作进行了编码，动作的数字更新如下：

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

我还能够修改发布的代码，用简单的箭头绘制一个简单的网格：

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

然而： i没有unicode可用于上面表$\pi\u\ast$中报告的nice 2是4方向箭头 ii…所以我没有试图在表action_random中的数值和一个有箭头的漂亮表之间编码双射

欢迎任何有助于解决问题i和ii的提示。

使用emojifont软件包可以获得更多unicode选项。在ggplot中添加family='EmojiOne'。下面是使用unicode的示例

编辑：四向箭头的破解：

不是最漂亮或更优雅的解决方案，但您可以使用软件包magick覆盖ggplots以获得方向箭头。制作两个绘图层，一个带有左右箭头U+2194，另一个带有上下箭头U+2195，然后合并，然后感谢@Billy34使代码更优雅：

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)

以下是我得到的结果：

我不能说这是有史以来最漂亮的代码，它是最有技巧的，但它可能会有所帮助！完成这项工作所花费的时间比我想承认的要多！

使用emojifont软件包可以让我获得更多的unicode选项。在ggplot中，您添加了family='EmojiOne'。下面是一个使用unicode的示例

编辑：四向箭头的破解：

不是最漂亮或更优雅的解决方案，但您可以使用软件包magick覆盖ggplots以获得方向箭头。制作两个绘图层，一个带有左右箭头U+2194，另一个带有上下箭头U+2195，然后合并，然后感谢@Billy34使代码更优雅：

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)

以下是我得到的结果：

---

我不能说这是迄今为止见过的最漂亮的代码，它是黑客所能做到的，但它可能会有所帮助！完成这项工作所花费的时间比我想承认的要多！

这里有一种网格+晶格的方法来重现矩阵：

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)

---

以下是一种网格+晶格的方法来重现矩阵：

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)

---

---

也许你应该看看你的相关代码。@nbro:我添加了一个编辑，其中有一个简短的示例，说明我是如何以数字方式编码动作的。也许你应该看看你的相关代码。@nbro:我添加了一个编辑，其中有一个简短的示例，说明我是如何以数字方式编码动作的。叠加两个geom_文本层不是比合并到图像更容易吗？你完全正确，@Billy34。我之前遇到一个错误，没有时间弄清楚它为什么不起作用。但现在我已经编辑了它。谢谢！谢谢你的输入，它确实很有趣。但是，通过叠加水平和垂直unicode箭头获得的正交箭头没有原来的箭头漂亮。我用tikz进行了尝试，它ch在绘制$2^4-1$方向集时非常灵活，但无法导入R中的tikz箭头。是的，@Bertrand。我尝试了另一种方法。但仍然非常黑客……你尝试过使用tikzDevice软件包吗？覆盖两个geom_文本层而不是合并到图像中不是更容易吗？你完全正确，@Billy34。我有一个错误早些时候，我没有时间弄清楚它为什么不起作用。但现在我编辑了它。谢谢！感谢您的输入，它确实很有趣。但是，通过叠加水平和垂直unicode箭头获得的正交箭头没有原始箭头漂亮。我试过使用tikz，它绘制起来非常灵活这套$2^4-1$directions，但无法导入R中的tikz箭头。是的，@Bertrand。我尝试了另一种方法。仍然非常黑客……你尝试过使用tikzDevice包吗？非常好的网格。谢谢你的帖子，它也让我发现了网格包。如果有帮助，很高兴。{grid}和{lattice}软件包是基本的R软件包，包含在R安装程序的每个版本中，因此您不需要使用“install.packages”手动安装它们。非常好的网格。感谢您的帖子，它还允许我发现网格软件包。如果有帮助，很高兴。{grid}和{lattice}软件包属于基本R软件包，包含在每个R安装程序版本中，因此您不需要使用“install.packages”手动安装它们