R: เมทริกซ์พร้อมลูกศรทิศทาง
ฉันพยายามทำซ้ำด้วย R อัลกอริทึมที่อธิบายไว้ใน Sutton and Barto (2018) แต่ฉันไม่สามารถสร้างเมทริกซ์ที่มีลูกศรตามที่ผู้เขียนอธิบายไว้ในหน้า 65:
ฉันพยายามใช้แพคเกจ "เขตข้อมูล" เพื่อจุดประสงค์นี้ แต่ไม่ประสบความสำเร็จมากนัก
ใน Python วิธีแก้ปัญหาที่ Shangtong Zhang และ Kenta Shimada เสนอนั้นอาศัยการใช้สัญลักษณ์ลูกศร: 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) ไม่มี Unicode สำหรับ nice 2 เป็นลูกศร 4 ทิศทางที่รายงานในตาราง$\pi_\ast$ด้านบน
(ii) ... ดังนั้นฉันจึงไม่ได้พยายามเขียนรหัส bijection ระหว่างค่าตัวเลขในตาราง "action_random" และตารางที่ดีที่มีลูกศรอยู่ในนั้น ...
คำแนะนำใด ๆ ที่ช่วยในการแก้ไขปัญหา (i) และ (ii) ยินดีต้อนรับ
คำตอบ
นี่คือวิธีกริด + ขัดแตะในการสร้างเมทริกซ์:
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)
การใช้แพคเกจช่วยemojifont
ให้ฉันได้รับตัวเลือก Unicode เพิ่มเติม ใน ggplot family='EmojiOne'
ของคุณเพิ่ม นี่คือตัวอย่างการใช้ Unicode
เพิ่มเติมเกี่ยวกับอีโมจิฟอนต์แพ็คเกจได้ที่นี่
แก้ไข : แฮ็กสำหรับลูกศร 4 ทิศทาง:
ไม่ใช่โซลูชันที่สวยที่สุดหรือหรูหรากว่า แต่คุณสามารถซ้อนทับ ggplots โดยใช้แพ็คเกจmagick
เพื่อรับลูกศรทิศทาง สร้างเลเยอร์พล็อตสองชั้นโดยหนึ่งมีลูกศรซ้าย - ขวา ( 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)
อัปเดต:
เช่นเดียวกับรหัสก่อนหน้านี้ แต่ไม่มีเกียรติมากขึ้น แต่ใกล้เคียงกับสิ่งที่คุณกำลังมองหา ...
Unicodes บางตัวใช้งานได้กับแบบอักษรบางแบบเท่านั้นดังนั้นขั้นตอนแรกคือการค้นหาว่าฟอนต์ใดใช้ได้กับ Unicode ที่คุณกำลังมองหา นี่คือตัวอย่างของการสนับสนุนแบบอักษรสำหรับประเภทของหนึ่งleftwards ลูกศรใช้ในตัวอย่างด้านล่าง
แน่นอนว่าไม่มีแบบอักษรใดในรายการที่เป็นแบบมาตรฐานเพราะชีวิตไม่ใช่เรื่องง่าย ขั้นตอนต่อไปคือการติดตั้งแบบอักษร ผมใช้ตัวอักษรSymbolaที่ฉันดาวน์โหลดที่นี่ คัดลอกไฟล์ฟอนต์ไปยังไดเร็กทอรี R ของคุณหรือไปยังโฟลเดอร์โปรเจ็กต์ของคุณหากคุณกำลังใช้โปรเจ็กต์
จากนั้นใช้ห้องสมุดshowtext แพคเกจอนุญาตให้คุณใช้แบบอักษรของระบบในกราฟิก (ต้องใช้แพ็คเกจsysfonts
) ถ้าตัวอักษรที่เป็นมาตรฐานในระบบปฏิบัติการของคุณผมขอแนะนำให้คุณดูที่แพคเกจ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')
นี่คือผลลัพธ์ที่ฉันได้รับ:
ฉันไม่สามารถพูดได้ว่านี่เป็นรหัสที่สวยที่สุดเท่าที่เคยเห็นมามันเหมือนกับการแฮ็ก แต่มันอาจจะมีประโยชน์! (ใช้เวลาทำนานกว่าที่ฉันอยากจะยอมรับ!)