Question

tl; dr 我想在plotOutput上覆盖imageOutput。我没有CSS / HTML知识。

我面临的全部问题：
另一个 tl; dr 我想复制this的光泽，并且必须快！

想象一下一个小的3 x 4 x 5 3D阵列，它由单位正方形组成（总共60个正方形）。我希望用户分别可视化这三个平面。对于每个平面XY，YZ和XZ，我都有三个imageOutput（或plotOutput）。在本文中，我将其称为plane。像this之类的东西（我只是在Google上搜索了此图片，而不是我的图片）。加载应用程序时，我渲染每个plane的中心，并用十字准线指向（十字线？）。现在，当用户单击任何plane（例如XY）时，我得到了光亮的单击的协调，并用新图像（在本例中为YZ和XZ）用新图像更新了其他plane。新的x和y进行了协调。同时更新所有三个的十字准线。最终结果就是图像here。除了全部三个都在单独的视图中。
所以我已经有执行此操作的代码，但是加载时间很麻烦。因为实际输入的尺寸为~ 250 x 250 x 100。三个平面全部加载大约需要2-3秒。该应用程序应该提供一个界面，可以以最少的延迟来快速轻松地查看飞机。所以基本上，我要加快速度。

关于使用的变量：

x()是输入的reactive。
meta()是一个reactive，存储着x()的尺寸。
values$xyz是长度为3的数组，对于十字准线为x，y和z。

由于这是一个复杂的问题，因此我试图在本文中尽可能地详细介绍。请原谅帖子的长度。

到目前为止，我已经尝试了一些方法：

第一个想法是仅在飞行中渲染飞机。我有plotOutput的{{1}}和下面的代码ui。
```
server
```
就像我上面提到的，非常慢。
想法output$plotXY <- renderPlot({ req(x()) par(oma = rep(0, 4), mar = rep(0, 4), bg = "black") graphics::image(1:meta()$X, 1:meta()$Y, x()[, , values$xyz[3]], col = gray(0:64/64), xlab = "", ylab = "", axes = FALSE, useRaster = T) abline(h = values$xyz[2], v = values$xyz[1], col = "red") })会更快，因此基本上将上述代码移植到ggplot2。
```
ggplot
```
这确实加快了过程，但是可以忽略不计。我使用了ggplot(melt(x()[, , values$xyz[3]]), aes(Var1, Var2, fill = value)) + geom_raster(show.legend = F) + theme_void() + scale_fill_gradient(low = "black", high = "white") + geom_vline(xintercept = values$xyz[1], color = "red") + geom_hline(yintercept = values$xyz[2], color = "red")。也尝试过this，但同样没有希望。
决定首先将所有平面（所有XY，YZ和XZ）另存为png，并保存到临时文件中，并在需要时加载。现在在microbenchmark中使用imageOutput。
```
ui
```
这明显更快，但是自然地，初始加载时间非常长！为了加快预处理速度，我尝试了# preprocessing: makePNG <- function(slice) { outfile = tempfile(fileext = ".png") dims = dim(slice) png(outfile, width = dims[1], height = dims[2]) par(mar = c(0,0,0,0)) image(slice, useRaster=T, axes=F, col = gray(0:64/64)) dev.off() return(outfile) } ... file_paths_XY <- apply(x(), 3, makePNG) # also in meta() ... # loading images: output$plotXY <- renderImage({ req(x()) pos = values$xyz[3] file_path = meta()$file_paths_XY[pos] list( src = file_path ) }, deleteFile = F)包，但是传输整个parallel的开销太昂贵了。我正在考虑实现一个惰性加载器，因此每个平面只能加载10个，如果需要，则再加载10个。尚未归结为实施。但是真正的问题是，我需要十字准线（还需要重新缩放和旋转）！我决定再次使用x()，并添加一个ggplot图层，将图像渲染为背景，并在绘图中添加十字线。与this类似。但是再次加载png并重做所有操作会减慢它的速度，老实说似乎没有用。我使用annotation_custom来更快地加载png。但是同样，太慢了。也magick。

我迷路了。我从未进行过优化，所以我不知道imager。我愿意尝试一下，但是我想知道这是否是正确的方向，或者尝试其他方法。我愿意接受所有建议。如果您需要更多详细信息或代码，请发表评论。谢谢！

编辑：标题大声笑，我想知道是否可能以某种方式将Rcpp覆盖在plotOutput上并获得imageOutput来添加十字准线。我猜测这将节省大量时间，并且应该足以加快速度。

更新：我想使其具有可重复性，但是我认为我没有足够的R和Shiny经验。这是一个闪亮的应用程序模块。较大的应用程序调用{{1}}并显示要显示的图像的路径。我将如何使其具有可复制性？

更新：我可能应该提到输入数组是灰度图像，但没有上限或下限的限制（它不受0-1范围限制）

更新：因此我在笔记本电脑上编写了一个微型应用程序，原始代码实际上非常快。我认为我们在工作中使用的RStudio服务器相当慢。尽管如此，我仍在发布代码。

ggplot

最终更新：事实证明，我们使用的服务器通常会在仿真和工作方面做很多繁重的工作，从而大大降低了代码的速度。尽管问题尚未解决，但我想我们正在寻找错误的问题。无论如何，我将把赏金授予西蒙。谢谢您的回答。

Answer 1

此方法使用3D阵列，其每个平面均为灰度图像。通过分别跟踪每种颜色，可以将其概括为rgb。受到在Matlab中处理矩阵的启发。

首先设置一些虚拟数据：

# GREY
G = runif(250*250*100)
G = array(G, c(250,250,100))

其中G是图像的灰度分量。

假设选择了坐标X = 40。然后我们提取YZ plane：

ptm = proc.time()
X = 40
YZ_panel = G[40,,]

这可以在ggplot中显示为图像：

g <- rasterGrob(YZ_panel, interpolate=TRUE)

qplot(c(1,10,10,1,1),c(1,1,25,25,1),geom="blank") +
  annotation_custom(g, xmin=0, xmax=10, ymin=0, ymax=25) +
  geom_line(aes(x=c(5,5), y=c(0,25)), color="red") +
  geom_line(aes(x=c(0,10), y=c(10,10)), color="red") + 
  coord_fixed()

使用proc.time()的结果不到半秒：

proc.time() - ptm
   user  system elapsed 
   0.18    0.03    0.21

您当然必须为每个plane重复此过程。

（已关闭）R闪亮应用程序中的覆盖小部件

1 个答案: