R：方向矢印のある行列
Jan 03 2021
Sutton and Barto（2018）で説明されているアルゴリズムをRで再現しようとしていますが、65ページの著者が説明しているような矢印の付いた行列を作成できませんでした。
この目的でパッケージ「fields」を使用しようとしましたが、あまり成功しませんでした。
Pythonでは、ShangtongZhangとKentaShimadaによって提案されたソリューションは、矢印記号の使用に依存しています：ACTIONS_FIGS = ['←'、 '↑'、 '→'、 '↓']が、これは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）表に報告されている4方向矢印であるnice2に使用できるUnicodeはありません。$\pi_\ast$上記
（ii）...したがって、テーブル「action_random」の数値と矢印の付いた素敵なテーブルの間の全単射をコーディングしようとしていませんでした...
問題（i）および（ii）の解決に役立つヒントは大歓迎です。
回答
1 AbdurRohman Jan 21 2021 at 22:01
マトリックスを再現するためのグリッド+格子の方法は次のとおりです。
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
パッケージを使用するemojifontと、より多くのUnicodeオプションを取得できます。ggplotにを追加しfamily='EmojiOne'ます。これはUnicodeを使用した例です
パッケージemojifontの詳細はこちら
編集：4方向矢印のハック：
最も美しいまたはよりエレガントなソリューションではありませんが、パッケージmagickを使用してggplotをオーバーレイし、方向矢印を取得できます。2つのプロットレイヤーを作成します。1つは左右の矢印（U+2194）で、もう1つは上下の矢印（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)
更新：
前のコードと同じように不親切ですが、探しているものに近い…
特定のUnicodeは特定のフォントでのみ機能するため、最初のステップは、探しているUnicodeで機能するフォントを見つけることです。以下の例で使用されているタイプの左向き矢印のフォントサポートの例を次に示します。
もちろん、人生はそれほど簡単ではないので、リストにあるフォントはどれも標準ではありません。したがって、次のステップはフォントをインストールすることです。ここでダウンロードしたフォントSymbolaを使用しました。プロジェクトを使用している場合は、フォントファイルをRディレクトリまたはプロジェクトフォルダにコピーします。
次に、ライブラリshowtextを使用します。このパッケージを使用すると、グラフィックでシステムフォントを使用できます（パッケージが必要ですsysfonts）。フォントがOSで標準である場合は、パッケージsystemfontsを確認することをお勧めします。
私の例では、私は矢印を使用\U1F800して\U1F801、その後、私の以前の例のように、私はそれらを重ね合わせ、（PS：あなたが浮気している可能性がありますnudge_yし、nudge_x中にgeom_textそれらが適切に整列得るために）：
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')
これが私が得た結果です：
これが今まで見た中で最も美しいコードであるとは言えません。ハックと同じくらいですが、役立つかもしれません。（これを行うには、私が認めたいよりも時間がかかりました！）