识别当前在EBImage闪亮显示中显示的帧

时间:2019-04-10 15:30:13

标签: r shiny shinydashboard

我已经使用EBImage生物导体包装编写了一个闪亮的应用程序,可以从显微镜图像中进行细胞分割。然后,我可以使用“ stackObjects”功能将分段的单元提取为图像堆栈,并使用“ display”功能显示这些单元。

我现在需要知道当前正在显示哪个帧,因为我将使用闪亮的应用程序中的物种识别来注释每个帧(长期使用它来构建卷积神经网络的训练数据集以使细胞ID自动化)

我找不到在闪亮的应用程序中标识当前正在显示哪个框架的方法。

这是我的第一个堆栈溢出帖子,因此,如果此请求的格式不理想,请原谅。例如,我不确定如何在此处上传文件以用作输入图像堆栈,但是下面给出了一个基本代码示例没有数据 ...

任何帮助将不胜感激。

library(shiny)
library(shinydashboard)
library(EBImage)

ui <- dashboardPage(

dashboardHeader(title = 'test display'),

dashboardBody(
    displayOutput('img1', width = '100%', height = '600px')
             )
)

server <- function(input, output, session) {

output$img1 <- renderDisplay({
        display(**Image Stack Here**)
    })

}

shinyApp(ui, server)

1 个答案:

答案 0 :(得分:0)

如果您的问题“我需要知道当前显示的是哪一帧”是指原始图像中的哪一帧用于生成stackObjects的堆栈,则可能只需将堆栈中的帧映射到用于生成堆栈的蒙版中的对象即可。如果是这样,也许这个例子会有所帮助。这发现奇数大小的原子核与帧信息一起显示在堆栈中。这种方法没有shiny独有。

# Use cell nuclei example from EBImage
  library(EBImage)
  nuc <- readImage(system.file('images', 'nuclei.tif', package='EBImage'))

# Create nuclear mask
  nmask <- thresh(nuc, 10, 10, 0.05)
  nmask <- opening(nmask, makeBrush(5, shape = "disc"))
  nmask <- fillHull(nmask)
  nmask <- bwlabel(nmask)

# Find very small and very large nuclei in each frame
  area <- apply(nmask, 3, function(x) table(x[x > 0]))
  typical <- lapply(area, function(x) which(x > 150 & x < 750))
  mask <- rmObjects(nmask, typical)

# Create stack of oddly sized nuclei
  stk <- stackObjects(mask, nuc)

# Determine frame in stack from frame in mask with findInterval
  nmax <- apply(mask, 3, max) # note that nuc had 4 frames
  index <- c(1, cumsum(nmax))
  query_frames <- c(1, 2, 15, 16, 27, 36) # random frames in stack
  findInterval(query_frames, index, rightmost.closed = TRUE)

这将query_frames中的值映射到原始nuc图像中的四个帧。这是在此使用的对象之上构建的该原理的另一个应用。

# Map object in stack to original frame from nuc
  dm <- dim(stk) # stack dimension (40 objects)
  nobjects <- tail(dm, 1)
  idx <- seq_len(nobjects) # index of each frame in stack
  frame <- findInterval(idx, index, rightmost.closed = TRUE)

# Visualize with frame label in upper 10% of each panel
  nx <- 8
  ix <- (idx - 1) %% nx
  iy <- (idx - 1) %/% nx
  plot(stk, all = TRUE, nx = nx)
  text(dm[1]*(ix + 0.1), dm[2] * (iy + 0.1), frame, col = 2, adj = c(0, 1))