基于HPC的Shiny App栅格计算并行化报错求助
2026-6-13
问题：HPC上并行计算植被指数的Shiny App报错
背景
我正在开发一款用于栅格计算的Shiny App，目标是在高性能计算集群（HPC）上并行计算植被指数，功能类似plimanshiny。程序在本地PC运行完全正常，但在分配了1节点40核、96GB内存的HPC环境下运行时报错。
核心报错代码片段
p <- wrap(values$raster_rgb) # Set up parallel backend plan(multisession, workers = input$numCores) # Use multiple cores # Parallel processing of raster indices raster_indices_rgb <- future_lapply(input$rgbIndices, function(idx) { idx_eq <- indices_equations$eq[indices_equations$index == idx] # Create function dynamically eval(parse(text = paste0(idx, " <- function(Red, Green, Blue, Alpha) { return(", idx_eq, ") }"))) # Process raster tiles x <- unwrap(p) raster_idx <- lapp(x, get(idx), usenames = TRUE) names(raster_idx) <- idx return(setNames(list(raster_idx), idx)) }) # Combine results into a named list raster_indices_rgb <- unlist(raster_indices_rgb, recursive = FALSE) if(length(raster_indices_rgb) > 0) { raster_indices_rgb <- rast(raster_indices_rgb) raster_no_soil_indices_rgb <- terra::mask(raster_indices_rgb, values$mask) values$indices_rgb_per_plot_without_soil <- exact_extract(raster_no_soil_indices_rgb, values$shape_file, fun = 'mean') #If only one vector is slected colnames does not work therefore this ifstatement: if (length(raster_indices_rgb) == 1){ values$indices_rgb_per_plot_without_soil <- as.data.frame(values$indices_rgb_per_plot_without_soil) colnames(values$indices_rgb_per_plot_without_soil) <- input$rgbIndices } colnames(values$indices_rgb_per_plot_without_soil) <- paste(colnames(values$indices_rgb_per_plot_without_soil), "without_soil", sep = "_") values$indices_rgb_per_plot_with_soil <- exact_extract(raster_indices_rgb, values$shape_file, fun = 'mean') #If only one vector is slected colnames does not work therefore this ifstatement: if (length(raster_indices_rgb) == 1){ values$indices_rgb_per_plot_with_soil <- as.data.frame(values$indices_rgb_per_plot_with_soil) colnames(values$indices_rgb_per_plot_with_soil) <- input$rgbIndices } colnames(values$indices_rgb_per_plot_with_soil) <- paste(colnames(values$indices_rgb_per_plot_with_soil), "with_soil", sep = "_") } plan(sequential)
报错信息
Warning: Error in : external pointer is not valid 95: <Anonymous> 94: stop 93: x@pntr$deepcopy 92: .local 91: deepcopy 89: .local 88: rast 83: observe 82: <observer:observeEvent(input$runAnalysis)> 3: runApp 2: print.shiny.appobj 1: <Anonymous>
已尝试的方案
- 使用
wrap()和unwrap()处理栅格对象，试图解决进程间外部指针传递问题，无效 - 切换
plan(multisession)和plan(multicore)两种并行计划，均无法解决报错
可复现代码示例
rm(list=ls()) # Required libraries if (!require("pacman")) install.packages("pacman") pacman::p_load( shiny, terra, sf, exactextractr, shinydashboard, DT, dplyr, shinyFiles, tidyverse, raster, tictoc, parallel, doParallel, future, foreach, future.apply ) #vegetation indices indices_equations <- data.frame( index = c("BI", "BIM", "SCI", "GLI", "HI", "NGRDI", "SI", "VARI", "HUE", "BGI", "PSRI", "NDVI"), eq = c("sqrt((Red^2+Green^2+Blue^2)/3)", "sqrt((Red*2+Green*2+Blue*2)/3)", "(Red-Green)/(Red+Green)", "(2*Green-Red-Blue)/(2*Green+Red+Blue)", "(2*Red-Green-Blue)/(Green-Blue)", "(Green-Red)/(Green+Red)", "(Red-Blue)/(Red+Blue)", "(Green-Red)/(Green+Red-Blue)", "atan(2*(Blue-Green-Red)/30.5*(Green-Red))", "Blue/Green", "(Red-Green)/RE", "(NIR-Red)/(NIR+Red)"), type = c("RGB", "RGB", "RGB", "RGB", "RGB", "RGB", "RGB", "RGB", "RGB", "RGB", "Multispectral", "Multispectral") ) # Create a sample 4-band RGBA raster create_sample_raster <- function(size = 100) { red <- matrix(runif(size^2, 0, 1), nrow = size) green <- matrix(runif(size^2, 0, 1), nrow = size) blue <- matrix(runif(size^2, 0, 1), nrow = size) alpha <- matrix(rep(255, size^2), nrow = size) r <- rast(red) g <- rast(green) b <- rast(blue) a <- rast(alpha) rgba <- c(r, g, b, a) names(rgba) <- c("Red", "Green", "Blue", "Alpha") return(rgba) } set.seed(145) raster_rgb <- create_sample_raster() names(raster_rgb) <- c("Red", "Green", "Blue", "Alpha") input <- list() input$rgbIndices <- c("BI", "BIM", "GLI") input$numCores <- availableCores() / 2 p <- wrap(raster_rgb) future::plan(future::multicore, workers = input$numCores) raster_indices_rgb <- future.apply::future_lapply(input$rgbIndices, function(idx) { idx_eq <- indices_equations$eq[indices_equations$index == idx] # Create function dynamically and set its environment idx_function <- eval(parse(text = paste0("function(Red, Green, Blue, Alpha) { return(", idx_eq, ") }"))) x <- terra::unwrap(p) raster_idx <- terra::lapp(x, fun = idx_function, usenames = TRUE) names(raster_idx) <- idx return(setNames(list(raster_idx), idx)) }) raster_indices_rgb <- do.call(c, raster_indices_rgb) future::plan(future::sequential) plot(raster_indices_rgb$BIM)
HPC上运行示例的报错
Error in .Call(list(name = "CppField__get", address = <pointer: (nil)>, : NULL value passed as symbol address
解决建议
- 避免动态函数+
get()的调用方式：并行子进程无法可靠访问主进程中动态创建的函数，建议直接在future_lapply的任务函数内定义并使用函数，不要依赖全局环境查找。修改示例中的函数创建逻辑：raster_indices_rgb <- future.apply::future_lapply(input$rgbIndices, function(idx) { idx_eq <- indices_equations$eq[indices_equations$index == idx] # 直接在内部定义函数并使用，不写入全局环境 idx_function <- eval(parse(text = paste0("function(Red, Green, Blue, Alpha) { return(", idx_eq, ") }"))) x <- terra::unwrap(p) raster_idx <- terra::lapp(x, fun = idx_function, usenames = TRUE) names(raster_idx) <- idx return(setNames(list(raster_idx), idx)) }) - 提前将栅格加载到内存：HPC环境下，栅格对象的外部指针可能因进程内存隔离失效，在
wrap()前用readAll()将栅格数据读入内存：raster_rgb <- readAll(raster_rgb) p <- wrap(raster_rgb) - 减少重复
unwrap()操作：每个并行任务都执行unwrap()可能引发资源冲突，建议在并行任务外完成unwrap()，拆分波段后传递给子进程，或者直接传递波段数据。 - 检查包版本兼容性：确保HPC上的R版本、
terra、future等包版本与本地完全一致，版本差异可能导致外部指针处理逻辑出错。 - 改用
terra原生并行：terra::lapp()本身支持通过cores参数启用并行，无需依赖future，可以避免进程间通信的指针问题：plan(sequential) # 先关闭future并行 # 定义所有指数的计算函数 index_functions <- lapply(input$rgbIndices, function(idx) { idx_eq <- indices_equations$eq[indices_equations$index == idx] eval(parse(text = paste0("function(Red, Green, Blue, Alpha) { return(", idx_eq, ") }"))) }) names(index_functions) <- input$rgbIndices # 使用terra原生并行计算 raster_indices_rgb <- lapp(raster_rgb, fun = index_functions, cores = input$numCores)
内容的提问来源于stack exchange，提问作者vbbraun
相关产品推荐
相关产品推荐
