使用 plot3d 和 knitr 繪制圖例的意外行為

Question

我正在嘗試使用knitr使用 rgl 生成一個帶有兩個 3d 散點圖的 html 文檔，但是當我嘗試向兩個圖添加圖例時遇到了問題。 使用完全相同的代碼（從一個塊復制並粘貼到另一個塊，然后更改要繪制的值），第一個圖的圖例以 html 方式顯示太大。 我生成了一個示例腳本，其中包含與我正在使用的數據類似的數據：

---
title: "example"
output: html_document
---

Example script

# First plot
```{r 1st chunk, webgl=TRUE, echo = FALSE, fig.width=10, fig.height=10}
library(rgl)
knitr::knit_hooks$set(webgl = hook_webgl)
dt <- data.frame(x = runif(70, min = 1, max = 10),
                 y = runif(70, min = -10, max = 1),
                 z = runif(70, min = -20, max = -10), 
                 groups = rep(c("Group1", "Group2", "Group3", "Group4", "Group5", "Group6", "Group7"), each = 10))
plot3d(dt$x, dt$y, dt$z, 
       xlab = "X", ylab = "Y", zlab = "Z",
       type ="n")
grid3d(c("x", "y+", "z"))
legend3d("bottomright",
       c("Group1", "Group2", "Group3", "Group4", "Group5", "Group6", "Group7"),
       col = c(1:7),
       pch = 20,
       bg = "black",
       bty = "n",
       y.intersp = 0.8,
       cex = 1.5)
for (i in seq_along(unique(dt$groups))){
  sub <- dt[dt$groups == unique(dt$groups)[i],]
  pch3d(sub$x, sub$y, sub$z,
        col = i,
        pch = 16,
        radius = 0.2,
        add = T)}
```

This first legend is way too large, while, with the exame same code, for the next plot, the legend is normal size 

# Second plot
```{r 2nd chunk, webgl=TRUE, echo = FALSE, fig.width=10, fig.height=10}
library(rgl)
knitr::knit_hooks$set(webgl = hook_webgl)
dt <- data.frame(x = runif(150, min = 2, max = 20),
                 y = runif(150, min = -20, max = 2),
                 z = runif(150, min = -30, max = -20), 
                 groups = rep(c("Group1", "Group2", "Group3", "Group4", "Group5", "Group6", "Group7", "Group8",
                                "Group9", "Group10", "Group11", "Group12", "Group13", "Group14", "Group15"), each = 10))
plot3d(dt$x, dt$y, dt$z, 
       xlab = "X", ylab = "Y", zlab = "Z",
       type ="n")
grid3d(c("x", "y+", "z"))
legend3d("bottomright",
       c("Group1", "Group2", "Group3", "Group4", "Group5", "Group6", "Group7", "Group8",
         "Group9", "Group10", "Group11", "Group12", "Group13", "Group14", "Group15"),
       col = c(1:15),
       pch = 20,
       bg = "black",
       bty = "n",
       y.intersp = 0.8,
       cex = 1.5)
for (i in seq_along(unique(dt$groups))){
  sub <- dt[dt$groups == unique(dt$groups)[i],]
  pch3d(sub$x, sub$y, sub$z,
        col = i,
        pch = 16,
        radius = 0.2,
        add = T)}
```

任何幫助都感激不盡！

Answer 1

這是一個有點怪異，我看了一下，注意到cex參數（這確實意味着“字符擴大”）在legend3d呼叫不知何故被解釋不同的呼叫打電話。 似乎是一個小錯誤。

但是我也發現你可以通過在每個繪圖之前添加一個open3d命令來修復它。 也許這是一個修復？

代碼：

---
title: "example"
output: html_document
---

Example script

```{r 0th chunk, webgl=TRUE, echo = FALSE}
library(rgl)
knitr::knit_hooks$set(webgl = hook_webgl)
```

# First plot


```{r 1st chunk, webgl=TRUE, echo = FALSE, fig.width=5, fig.height=5}
glob_cex <- 0.6

open3d()
dt <- data.frame(x = runif(70, min = 1, max = 10),
                 y = runif(70, min = -10, max = 1),
                 z = runif(70, min = -20, max = -10), 
                 groups = rep(c("Group1", "Group2", "Group3", "Group4", "Group5", "Group6", "Group7"), each = 10))
plot3d(dt$x, dt$y, dt$z, 
       xlab = "X", ylab = "Y", zlab = "Z",
       type ="n")
grid3d(c("x", "y+", "z"))
legend3d("bottomright",
       c("Group1", "Group2", "Group3", "Group4", "Group5", "Group6", "Group7"),
       col = c(1:7),
       pch = 20,
       bg = "black",
       bty = "n",
       y.intersp = 0.8,
       cex = 0.8 )
for (i in seq_along(unique(dt$groups))){
  sub <- dt[dt$groups == unique(dt$groups)[i],]
  pch3d(sub$x, sub$y, sub$z,
        col = i,
        pch = 16,
        radius = 0.2,
        add = T)}
```

Legends are now the same size by adding an open3d() command before each plot.

# Second plot
```{r 2nd chunk, webgl=TRUE, echo = FALSE, fig.width=5, fig.height=5}
open3d()
dt <- data.frame(x = runif(150, min = 2, max = 20),
                 y = runif(150, min = -20, max = 2),
                 z = runif(150, min = -30, max = -20), 
                 groups = rep(c("Group1", "Group2", "Group3", "Group4", "Group5", "Group6", "Group7", "Group8",
                                "Group9", "Group10", "Group11", "Group12", "Group13", "Group14", "Group15"), each = 10))
plot3d(dt$x, dt$y, dt$z, 
       xlab = "X", ylab = "Y", zlab = "Z",
       type ="n")
grid3d(c("x", "y+", "z"))
legend3d("bottomright",
       c("Group1", "Group2", "Group3", "Group4", "Group5", "Group6", "Group7", "Group8",
         "Group9", "Group10", "Group11", "Group12", "Group13", "Group14", "Group15"),
       col = c(1:15),
       pch = 20,
       bg = "black",
       bty = "n",
       y.intersp = 0.8,
       cex = 0.8 )
for (i in seq_along(unique(dt$groups))){
  sub <- dt[dt$groups == unique(dt$groups)[i],]
  pch3d(sub$x, sub$y, sub$z,
        col = i,
        pch = 16,
        radius = 0.2,
        add = T)}
```

截屏：

Answer 2

我建議你不要使用webgl=TRUE ，在底部放置一個rglwidget()調用。 這使得文本太大，因為它是從 256x256 rgl 小窗口放大的； 使用r3dDefaults$windowRect <- c(0,0,1000,1000) （或類似的大值）以獲得更好的尺寸。

您可能還想在開始時使用options(rgl.useNULL = TRUE) ，這樣您就不會在編織時彈出窗口。 這有一個副作用，即允許您將r3dDefaults$windowRect值設置為大於物理屏幕的值。

r3dDefaults$windowRect和options("rgl.useNULL")值應該只需要在文檔頂部附近設置一次，除非您明確更改它們，否則將應用於所有以下繪圖。