如何在 R 闪亮应用程序中运行 IPDfromKM 包中的 R 函数 getpoints()，该应用程序在 R 中弹出一个利用点击捕获坐标的绘图？

Question

我正在尝试将我编写的一些 R 代码转换为 R 闪亮应用程序，以便其他人可以更轻松地使用它。该代码使用了一个名为

IPDfromKM

的包。问题的主要功能是

getpoints()

，它在 R 中将生成一个绘图，用户需要单击最大 X 和最大 Y 坐标，然后单击整个 KM 曲线，将坐标提取到数据框中。但是，我无法让它在我的 R闪亮应用程序中工作。

有一个 链接 指向创建者提供的工作 R 闪亮应用程序

这是 getpoints() 代码：

getpoints <- function(f,x1,x2,y1,y2){

  ## if bitmap
  if (typeof(f)=="character")
      { lfname <- tolower(f)
       if ((strsplit(lfname,".jpeg")[[1]]==lfname) && (strsplit(lfname,".tiff")[[1]]==lfname) &&
            (strsplit(lfname,".bmp")[[1]]==lfname) && (strsplit(lfname,".png")[[1]]==lfname) &&
           (strsplit(lfname,".jpg")[[1]]==lfname))
         {stop ("This function can only process bitmap images in JPEG, PNG,BMP, or TIFF formate.")}
       img <- readbitmap::read.bitmap(f)
      } else if (typeof(f)=="double")
      {
        img <- f
      } else {
        stop ("Please double check the format of the image file.")
      }
  ## function to read the bitmap and points on x-axis and y-axis
  axispoints <- function(img){
    op <- par(mar = c(0, 0, 0, 0))
    on.exit(par(op))
    plot.new()
    rasterImage(img, 0, 0, 1, 1)
    message("You need to define the points on the x and y axis according to your input x1,x2,y1,y2. \n")
    message("Click in the order of left x-axis point (x1), right x-axis point(x2),
      lower y-axis point(y1), and upper y-axis point(y2). \n")
    x1 <- as.data.frame(locator(n = 1,type = 'p',pch = 4,col = 'blue',lwd = 2))
    x2 <- as.data.frame(locator(n = 1,type = 'p',pch = 4,col = 'blue',lwd = 2))
    y1 <- as.data.frame(locator(n = 1,type = 'p',pch = 3,col = 'red',lwd = 2))
    y2 <- as.data.frame(locator(n = 1,type = 'p',pch = 3,col = 'red',lwd = 2))
    ap <- rbind(x1,x2,y1,y2)
    return(ap)
  }

  ## function to calibrate the points to the appropriate coordinates
  calibrate <-  function(ap,data,x1,x2,y1,y2){
    x  <- ap$x[c(1,2)]
    y  <- ap$y[c(3,4)]
    cx <- lm(formula = c(x1,x2) ~ c(x))$coeff
    cy <- lm(formula = c(y1,y2) ~ c(y))$coeff
    data$x <- data$x*cx[2]+cx[1]
    data$y <- data$y*cy[2]+cy[1]
    return(as.data.frame(data))
   }

  ## take the points
  ap <- axispoints(img)
  message("Mouse click on the K-M curve to take the points of interest. The points will only be labled when you finish all the clicks.")
  takepoints <- locator(n=512,type='p',pch=1,col='orange4',lwd=1.2,cex=1.2)
  df <- calibrate(ap,takepoints,x1,x2,y1,y2)
  par()
  return(df)
}

我有点不知道如何在我的主面板中执行此操作。我尝试过使用

plotOutput()

、

imageOutput()

，并调用以下函数的变体，但没有弹出任何内容，也没有像在 R studio 中那样工作。我觉得问题在于“getpoints()”函数执行了 3 件事：

1. 显示上传文件中的图像。

2. 允许用户单击并存储多个点。

3. 返回数据框。

我需要将函数的组件拆分为单独的步骤吗？

createPoints<-reactive({
    
    #Read File
    file <- input$file1
    ext <- tools::file_ext(file$datapath)
    req(file)
    validate(need(ext == "png", "Please upload a .png file"))
    
    ##should run the function that generates a plot for clicking coordinates and stores them in a data frame
    points<-getpoints(file,x1=0, x2=input$Xmax,y1=0, y2=100)
  
    return(points)
    
  })

output$getPointsPlot<-renderPlot(
    
    createPoints()
    
  )

Answer 1

主要编辑： 解决方案确实是将功能分解为其组成部分。如果有人好奇我是如何处理的：

library(shiny)
library(IPDfromKM)
library(png)

ui <- fluidPage(
  titlePanel("Extracting Coordinates from KM Curves"),
  sidebarLayout(
    sidebarPanel(
      fileInput("file", "Upload Image", accept = c(".png", ".jpeg", ".jpg", ".bmp", ".tiff")),
      actionButton("reset", "Reset"),
      downloadButton("download", "Download Data")
    ),
    mainPanel(
      plotOutput("plot", click = "plot_click", width="1000px", height="800px"),
      tableOutput("coordinates")
    )
  )
)

server <- function(input, output) {
  values <- reactiveValues(
    x = numeric(),
    y = numeric(),
    xmin = NULL,
    xmax = NULL,
    ymin = NULL,
    ymax = NULL,
    click_count = 0
  )
  
  observeEvent(input$reset, {
    values$x <- numeric()
    values$y <- numeric()
    values$xmin <- NULL
    values$xmax <- NULL
    values$ymin <- NULL
    values$ymax <- NULL
    values$click_count <- 0
  })
  
  output$plot <- renderPlot({
    req(input$file)
    img <- readPNG(input$file$datapath)
    plot(NA, xlim = c(0, ncol(img)), ylim = c(0, nrow(img)), type = "n", xlab = "", ylab = "", xaxt = "n", yaxt = "n")
    rasterImage(img, 0, 0, ncol(img), nrow(img))
    points(values$x, values$y, pch = 19, col = "red")
  })
  
  observeEvent(input$plot_click, {
    values$click_count <- values$click_count + 1
    if (values$click_count == 1) {
      values$xmin <- input$plot_click$x
    } else if (values$click_count == 2) {
      values$xmax <- input$plot_click$x
    } else if (values$click_count == 3) {
      values$ymin <- input$plot_click$y
    } else if (values$click_count == 4) {
      values$ymax <- input$plot_click$y
    } else {
      values$x <- c(values$x, input$plot_click$x)
      values$y <- c(values$y, input$plot_click$y)
    }
  })
  
  output$coordinates <- renderTable({
    if (!is.null(values$xmin) && !is.null(values$xmax) && !is.null(values$ymin) && !is.null(values$ymax)) {
      calibrated_x <- (values$x - values$xmin) / (values$xmax - values$xmin)
      calibrated_y <- (values$y - values$ymin) / (values$ymax - values$ymin)
      data.frame(x = calibrated_x, y = calibrated_y)
    } else {
      data.frame(x = values$x, y = values$y)
    }
  })
  
  output$download <- downloadHandler(
    filename = function() {
      paste("data-", Sys.Date(), ".txt", sep = "")
    },
    content = function(file) {
      write.table(isolate(output$coordinates), file, row.names = FALSE, sep = "\t")
    }
  )
}


shinyApp(ui, server)