library(raster)library(data.table)in_dir <- "C:/Users/A/Desktop/预测因子"out_dir <- in_dirtif_files <- list.files(in_dir, pattern="\\.tif$", full.names=TRUE, ignore.case=TRUE)stopifnot(length(tif_files) > 0)ref <- raster(tif_files[1])align_report <- data.frame( file = basename(tif_files), res_x = NA_real_, res_y = NA_real_, nrow = NA_integer_, ncol = NA_integer_, ncell = NA_integer_, xmin = NA_real_, xmax = NA_real_, ymin = NA_real_, ymax = NA_real_, crs = NA_character_, same_as_ref = NA, stringsAsFactors = FALSE)for(i in seq_along(tif_files)) { r <- raster(tif_files[i]) rr <- res(r) e <- extent(r) align_report$res_x[i] <- rr[1] align_report$res_y[i] <- rr[2] align_report$nrow[i] <- nrow(r) align_report$ncol[i] <- ncol(r) align_report$ncell[i] <- ncell(r) align_report$xmin[i] <- e@xmin align_report$xmax[i] <- e@xmax align_report$ymin[i] <- e@ymin align_report$ymax[i] <- e@ymax align_report$crs[i] <- as.character(crs(r)) align_report$same_as_ref[i] <- isTRUE(all.equal(res(r), res(ref))) && isTRUE(all.equal(extent(r), extent(ref))) && (nrow(r) == nrow(ref)) && (ncol(r) == ncol(ref)) && isTRUE(compareCRS(r, ref))}align_reportwrite.csv(align_report, file.path(out_dir, "align_report.csv"), row.names = FALSE)#统一对齐aligned_dir <- file.path(out_dir, "aligned_to_ref")if(!dir.exists(aligned_dir)) dir.create(aligned_dir, recursive = TRUE)aligned_files <- character(length(tif_files))for(i in seq_along(tif_files)) { f <- tif_files[i] r <- raster(f) out_f <- file.path(aligned_dir, paste0(tools::file_path_sans_ext(basename(f)), "_aligned.tif")) aligned_files[i] <- out_f if(align_report$same_as_ref[i] && file.exists(out_f)) { cat("", basename(out_f), "\n") next } if(align_report$same_as_ref[i]) { cat("", basename(f), "->", basename(out_f), "\n") writeRaster(r, out_f, overwrite = TRUE) } else { cat("", basename(f), "->", basename(out_f), "\n") r2 <- resample(r, ref, method = "bilinear") writeRaster(r2, out_f, overwrite = TRUE) }}#生成s <- stack(aligned_files)nm <- tools::file_path_sans_ext(basename(aligned_files))nm <- sub("_aligned$", "", nm) nm <- make.names(nm, unique = TRUE)names(s) <- nmcoords <- xyFromCell(ref, 1:ncell(ref))vals_mat <- getValues(s)big <- data.frame(x = coords[,1], y = coords[,2], vals_mat, check.names = FALSE)#过滤：只保留“至少一个指标非 NA”的像元vars <- setdiff(names(big), c("x", "y"))keep <- rowSums(!is.na(big[, vars, drop = FALSE])) > 1 #这里的0不针对具体栅格数值，针对的是每个栅格像素点对应的指标有几个，所以如果我们想真正对齐，我们可以改成1、2...，来削减掉多出的像素点big_f <- big[keep, ]out_csv <- file.path(out_dir,"predictors.csv")fwrite(big_f,file = out_csv)
