R: เมทริกซ์พร้อมลูกศรทิศทาง

Jan 03 2021

ฉันพยายามทำซ้ำด้วย 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) ยินดีต้อนรับ

คำตอบ

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

เพิ่มเติมเกี่ยวกับอีโมจิฟอนต์แพ็คเกจได้ที่นี่

แก้ไข : แฮ็กสำหรับลูกศร 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')

นี่คือผลลัพธ์ที่ฉันได้รับ:

ฉันไม่สามารถพูดได้ว่านี่เป็นรหัสที่สวยที่สุดเท่าที่เคยเห็นมามันเหมือนกับการแฮ็ก แต่มันอาจจะมีประโยชน์! (ใช้เวลาทำนานกว่าที่ฉันอยากจะยอมรับ!)