RMarkdown不会在HTML中绘制图形

我一直在用Rmarkdown编写一个HTML文档

该文档有几个sp图和GG图，它们都显示在HTML中

但是当我调用plotK时，它是stpp包中的一个函数，用于绘制时空不均匀的k函数STIKhat，该图不会出现在HTML中

以下是Rmarkdown的一个可复制示例：

---
title: "Untitled"
output: html_document
---

```{r}
library(stpp)
data(fmd)
data(northcumbria)
FMD<-as.3dpoints(fmd[,1]/1000,fmd[,2]/1000,fmd[,3])
Northcumbria=northcumbria/1000
# estimation of the temporal intensity
Mt<-density(FMD[,3],n=1000)
mut<-Mt$y[findInterval(FMD[,3],Mt$x)]*dim(FMD)[1]
# estimation of the spatial intensity
h<-mse2d(as.points(FMD[,1:2]), Northcumbria, nsmse=50, range=4)
h<-h$h[which.min(h$mse)]
Ms<-kernel2d(as.points(FMD[,1:2]), Northcumbria, h, nx=5000, ny=5000)
atx<-findInterval(x=FMD[,1],vec=Ms$x)
aty<-findInterval(x=FMD[,2],vec=Ms$y)
mhat<-NULL
for(i in 1:length(atx)) mhat<-c(mhat,Ms$z[atx[i],aty[i]])
# estimation of the STIK function
u <- seq(0,10,by=1)
v <- seq(0,15,by=1)
stik1 <- STIKhat(xyt=FMD, s.region=northcumbria/1000,t.region=c(1,200),
                 lambda=mhat*mut/dim(FMD)[1], dist=u, times=v, infectious=TRUE)
```

```{r}
plotK(stik1)
```

编织后，绘图不会显示在HTML中。有人知道发生了什么吗

---

非常感谢你

在绘图块中使用一些额外的包来尝试此操作：

library(png)
library(grid)
library(gridExtra)

plotK(stik1)
dev.print(png, "plot.png", width=480, height=480)
img <- readPNG("plot.png")
img <- rasterGrob(img)
grid.draw(img)

---

这个问题有点陈腐，但我忍不住把刚才我注意到的@ryanm评论当作一个有趣的挑战。正如我在上面的评论中提到的，问题在于plotK函数如何操作设备。一些不必要的修剪？plotK函数中的代码解决了以下问题：

---
title: "Untitled"
output: html_document
---

```{r}
library(stpp)

data(fmd)
data(northcumbria)
FMD<-as.3dpoints(fmd[,1]/1000,fmd[,2]/1000,fmd[,3])
Northcumbria=northcumbria/1000
# estimation of the temporal intensity
Mt<-density(FMD[,3],n=1000)
mut<-Mt$y[findInterval(FMD[,3],Mt$x)]*dim(FMD)[1]
# estimation of the spatial intensity
h<-mse2d(as.points(FMD[,1:2]), Northcumbria, nsmse=50, range=4)
h<-h$h[which.min(h$mse)]
Ms<-kernel2d(as.points(FMD[,1:2]), Northcumbria, h, nx=5000, ny=5000)
atx<-findInterval(x=FMD[,1],vec=Ms$x)
aty<-findInterval(x=FMD[,2],vec=Ms$y)
mhat<-NULL
for(i in 1:length(atx)) mhat<-c(mhat,Ms$z[atx[i],aty[i]])
# estimation of the STIK function
u <- seq(0,10,by=1)
v <- seq(0,15,by=1)
stik1 <- STIKhat(xyt=FMD, s.region=northcumbria/1000,t.region=c(1,200),
                 lambda=mhat*mut/dim(FMD)[1], dist=u, times=v, infectious=TRUE)
```

```{r,echo=FALSE}
plotK <- function (K, n = 15, L = FALSE, type = "contour", legend = TRUE, 
                   which = NULL, main = NULL, ...) 
{
  old.par <- par(no.readonly = TRUE)
  on.exit(par(old.par))

  correc = c("none", "isotropic", "border", "modified.border", 
             "translate")
  correc2 = K$correction
  id <- match(correc2, correc, nomatch = NA)
  if ((is.null(which) && length(id) > 1) || any(is.na(match(which, 
                                                            correc, nomatch = NA)))) {
    mess <- paste("Please specify the argument 'which', among:", 
                  paste(dQuote(correc2), collapse = ", "))
    stop(mess, call. = FALSE)
  }
  if (isTRUE(K$infectious)) 
    which = "isotropic"
  if (is.matrix(K$Khat)) {
    if (is.null(which)) 
      which = correc2
    else {
      if (!(is.null(which)) && which != correc2) {
        mess <- paste("Argument 'which' should be", paste(dQuote(correc2), 
                                                          collapse = ", "))
        stop(mess, call. = FALSE)
      }
    }
  }
  if (!is.matrix(K$Khat)) {
    id <- match(which, correc2, nomatch = NA)
    if (is.na(id)) {
      mess <- paste("Please specify the argument 'which', among:", 
                    paste(dQuote(correc2), collapse = ", "))
      stop(mess, call. = FALSE)
    }
    else K$Khat = K$Khat[[id]]
  }
  if (!is.null(main)) {
    titl = main
    subtitl = ""
    if (isTRUE(L)) 
      k <- K$Khat - K$Ktheo
    else k <- K$Khat
  }
  else {
    if (isTRUE(L)) {
      k <- K$Khat - K$Ktheo
      subtitl <- paste("edge correction method: ", which, 
                       sep = "")
      if (isTRUE(K$infectious)) 
        titl <- expression(hat(K)[ST] * group("(", list(u, 
                                                        v), ")") - pi * u^2 * v)
      else titl <- expression(hat(K)[ST] * group("(", list(u, 
                                                           v), ")") - 2 * pi * u^2 * v)
    }
    else {
      k <- K$Khat
      titl = expression(hat(K)[ST] * group("(", list(u, 
                                                     v), ")"))
      subtitl <- paste("edge correction method: ", which, 
                       sep = "")
    }
  }
  typeplot = c("contour", "image", "persp")
  id <- match(type, typeplot, nomatch = NA)
  if (any(nbg <- is.na(id))) {
    mess <- paste("unrecognised plot type:", paste(dQuote(type[nbg]), 
                                                   collapse = ", "))
    stop(mess, call. = FALSE)
  }
  if ((length(id) != 1) || is.na(id)) 
    stop("Please specify one type among \"contour\", \"image\" and \"persp\" ")
  typeplot = rep(0, 3)
  typeplot[id] = 1
  colo <- colorRampPalette(c("red", "white", "blue"))
  M <- max(abs(range(k)))
  M <- pretty(c(-M, M), n = n)
  n <- length(M)
  COL <- colo(n)
  if (typeplot[3] == 1) {
    mask <- matrix(0, ncol = length(K$times), nrow = length(K$dist))
    for (i in 1:length(K$dist)) {
      for (j in 1:length(K$times)) {
        mask[i, j] <- COL[findInterval(x = k[i, j], vec = M)]
      }
    }
    COL <- mask[1:(length(K$dist) - 1), 1:(length(K$times) - 
                                             1)]
    if (isTRUE(legend)) {
      par(cex.lab = 2, cex.axis = 1.5, font = 2, lwd = 1, 
          mar = c(0, 0, 3, 0))
      par(fig = c(0, 0.825, 0, 1))
      persp(x = K$dist, y = K$times, z = k, xlab = "u", 
            ylab = "v", zlab = "", expand = 1, col = COL, 
            ...)
      title(titl, cex.main = 1.5, sub = subtitl, outer = TRUE, 
            line = -1)
      par(fig = c(0.825, 1, 0, 1))
      mini <- findInterval(x = min(k, na.rm = TRUE), vec = M)
      maxi <- findInterval(x = max(k, na.rm = TRUE), vec = M)
      legend("right", fill = colo(n)[maxi:mini], legend = M[maxi:mini], 
             horiz = F, bty = "n")
    }
    else {
      par(cex.lab = 2, cex.axis = 1.5, font = 2, lwd = 1)
      persp(x = K$dist, y = K$times, z = k, xlab = "u", 
            ylab = "v", zlab = "", expand = 1, col = COL, 
            ...)
      title(titl, cex.main = 1.5, sub = subtitl)
    }
  }
  if (typeplot[1] == 1) {
    if (isTRUE(legend)) {
      par(cex.lab = 1.5, cex.axis = 1.5, font = 2, plt = c(0, 
                                                           1, 0, 1), lwd = 1, mar = c(0.5, 0.5, 2.5, 0.5), 
          las = 1)
      par(fig = c(0.1, 0.825, 0.1, 1))
      contour(K$dist, K$times, k, labcex = 1.5, levels = M, 
              drawlabels = F, col = colo(n), zlim = range(M), 
              axes = F)
      box(lwd = 2)
      at <- axTicks(1)
      axis(1, at = at[1:length(at)], labels = at[1:length(at)])
      at <- axTicks(2)
      axis(2, at = at[1:length(at)], labels = at[1:length(at)])
      title(titl, cex.main = 1.5, sub = subtitl, outer = TRUE, 
            line = -1)
      par(fig = c(0, 1, 0.1, 1))
      mini <- findInterval(x = min(k, na.rm = TRUE), vec = M)
      maxi <- findInterval(x = max(k, na.rm = TRUE), vec = M)
      legend("right", fill = colo(n)[maxi:mini], legend = M[maxi:mini], 
             horiz = F, bty = "n")
    }
    else {
      par(cex.lab = 2, cex.axis = 1.5, font = 2, lwd = 2, 
          las = 1)
      contour(K$dist, K$times, k, labcex = 1.5, levels = M, 
              drawlabels = T, col = colo(n), zlim = range(M), 
              axes = F)
      box(lwd = 2)
      at <- axTicks(1)
      axis(1, at = at[1:length(at)], labels = at[1:length(at)])
      at <- axTicks(2)
      axis(2, at = at[1:length(at)], labels = at[1:length(at)])
      title(titl, cex.main = 1.5, sub = subtitl)
    }
  }
  if (typeplot[2] == 1) {
    if (isTRUE(legend)) {
      par(cex.lab = 1.5, cex.axis = 1.5, font = 2, lwd = 1, 
          plt = c(0, 1, 0, 1), mar = c(0.5, 0.5, 2.5, 0.5), 
          las = 1)
      par(fig = c(0.1, 0.825, 0.1, 1))
      image(K$dist, K$times, k, col = colo(n), zlim = range(M), 
            axes = F, xlab = "", ylab = "")
      box(lwd = 2)
      at <- axTicks(1)
      axis(1, at = at[1:length(at)], labels = at[1:length(at)])
      at <- axTicks(2)
      axis(2, at = at[1:length(at)], labels = at[1:length(at)])
      title(titl, cex.main = 1.5, sub = subtitl, outer = TRUE, 
            line = -1)
      par(fig = c(0, 1, 0.1, 1))
      mini <- findInterval(x = min(k, na.rm = TRUE), vec = M)
      maxi <- findInterval(x = max(k, na.rm = TRUE), vec = M)
      legend("right", fill = colo(n)[maxi:mini], legend = M[maxi:mini], 
             horiz = F, bty = "n")
    }
    else {
      par(cex.lab = 2, cex.axis = 1.5, font = 2, lwd = 2, 
          las = 1)
      image(K$dist, K$times, k, col = colo(n), zlim = range(M), 
            axes = F, xlab = "", ylab = "")
      box(lwd = 2)
      at <- axTicks(1)
      axis(1, at = at[1:length(at)], labels = at[1:length(at)])
      at <- axTicks(2)
      axis(2, at = at[1:length(at)], labels = at[1:length(at)])
      title(titl, cex.main = 1.5, sub = subtitl)
    }
  }
  par(old.par)
}
```

```{r}
plotK(stik1)
```

---

如果您经常使用stpp软件包，可能值得向维护人员发送一封电子邮件，说明为什么有必要弄乱设备。

谢谢您的帮助！就这么做了。虽然当我运行时，它检索到错误：dev.printpng中的错误，plot.png:只能从屏幕打印设备调用：。。。使用CallingHandlers->withVisible->eval->eval->dev.print Execution halted我刚刚用RStudio尝试了你的例子，效果很好！在RMarkdown中编织时，它就是不起作用！我真的不明白发生了什么事！由于某些原因，RStudio图形设备渲染图像时没有问题。任何其他设备似乎都失败了。更糟糕的情况是：先创建图像文件，然后导入文件，然后在Rmarkdown中打印。我想这是一个解决方案，尽管这是一个与可复制研究相反的lil。我正在浏览plotK的源代码，因为也许通过将绘制新图形的部分更改为新窗口，我可以解决这个问题。如果没有，我会采纳你的建议。非常感谢您的帮助打印plotK函数。问题很可能在于顶部的代码对设备造成了干扰。