创建函数以避免循环

Question

谁能在这里突出显示可以变成功能的区域？如果是这样，怎么办？ 是否有编写函数或编写更简洁脚本的一般规则？ 任何人都可以在这个脚本中看到任何危险的坏习惯吗？

示例上下文：

此脚本的目的是通过轨道坐标运行。对于每个位置，我想在指定的错误字段中生成 9 个随机样本。对于每个位置错误和原始点（总共 10 个），我希望从源中提取数据。在这种情况下，与形状文件的距离。然后我想取提取数据的平均值并将其添加回原始轨道文件。

示例数据：

Date_Time           longitude       latitude 
27/10/2011 15:15    -91.98876953    1.671900034 
30/10/2011 14:31    -91.91790771    1.955003262 
30/10/2011 15:34    -91.91873169    1.961261749 
30/10/2011 20:55    -91.86060333    1.996331811 
31/10/2011 04:03    -91.67115021    1.929548025 
03/11/2011 18:36    -90.67552948    1.850875616 
04/11/2011 18:26    -90.65361023    1.799352288 
07/11/2011 19:29    -92.13287354    0.755102754 
07/11/2011 20:28    -92.13739014    0.783674061 
27/12/2011 13:43    -88.16407776    -4.953748703
07/01/2012 18:44    -82.51725006    -5.717019081
07/01/2012 19:30    -82.50763702    -5.706347942
07/01/2012 20:28    -82.50556183    -5.696153641 
07/01/2012 21:10    -82.50305176    -5.685819626
08/01/2012 00:27    -82.18003845    -5.623015404 
08/01/2012 18:37    -82.17269897    -5.61870575 
08/01/2012 19:20    -82.16355133    -5.612465382 

这个数据代表一个文件，列表中会有很多个文件。

实现任务的示例脚本：

#### Packages ####

library(dplyr)
library(geosphere)
library(rgdal)
library(rgeos)
library(truncnorm) 

# Load files

dir <- 'C:/Users/Documents/PhD/Chapters/'
sfolder <- paste0(dir, 'Data/Tracks/')
sfiles <- list.files(sfolder , '.csv', recursive = TRUE)

## Load the contours for proximity measurements 
# 200
contour2 <- readOGR(paste0(dir, 'QGIS/Base layers/2GEBCO_2020_Contour_200.gpkg'))

# 1000
contour1 <- readOGR(paste0(dir, 'QGIS/Base layers/2GEBCO_2020_Contour_1000.gpkg'))

# Land 
land <- readOGR(paste0(dir, 'QGIS/Base layers/GEBCO_2020_Contour_0.gpkg'))

# List of contours to extract 
extracts <- c('200','1000', '0')

# Extract proximity data for all tracks 

for (o in 1:length(sfiles))
{
  # o <- 1

tagType <- dirname(dirname(dirname((sfiles [o])))) # gives 'ARGOS' or 'PSAT' 
track <- read.csv(paste0(sfold , sfiles [o]))
ntrack <- nrow(track)

# Create data frame for proximity measures
proximity <-  data.frame(matrix(ncol = 3, nrow = ntrack))

# Generate random samples of each point 

for(i in 1:nrow(track))
{
  # i <- 1
  errors <- data.frame(matrix(ncol = 2, nrow = 10))

  if(tagType == 'PSAT')
  {
    meanx <- mean(track$longitude[i]-0.53, track$longitude[i]+0.53)
    meany <- mean(track$latitude[i]-1.08, track$latitude[i]+1.08)
    errors[,1] <-  rnorm(n=10, a=track$longitude[i]-0.53, b=track$longitude[i]+0.53, meanx)
    errors[,2] <- rtruncnorm(n=10, a=track$latitude[i]-1.08, b=track$latitude[i]+1.08, meany)
  }

  if(tagType == 'ARGOS')
  {
    meanx <- mean(track$longitude[i]-0.12, track$longitude[i]+0.12)
    meany <- mean(track$latitude[i]-0.12, track$latitude[i]+0.12)
    errors[,1] <-  rtruncnorm(n=10, a=track$longitude[i]-0.12, b=track$longitude[i]+0.12, meanx)
    errors[,2] <- rtruncnorm(n=10, a=track$latitude[i]-0.12, b=track$latitude[i]+0.12, meany)
  } 

errors[1,] <- c(track$longitude[i],track$latitude[i])  
colnames(errors) <- c('longitude', 'latitude')
errTrack <- SpatialPoints(errors[,c(1,2)])


# Now to get coordinates from contour files 

for(a in 1:length(extracts))
{
  # a <- 2
  extract <- extracts[a]

  if(extract == '200')
  { contour <- contour2 }
  if(extract == '1000')
  { contour <- contour1 }
  if(extract == '0')
  { contour <- land }

n <- length(errTrack) # 10 for 9 random samples + original location 
distances <- data.frame(matrix(ncol = 2, nrow = n))

for (e in seq_along(errTrack)) {
  distances[e,] <- coordinates(gNearestPoints(errTrack[e], contour))[2,]
}

allDist <- as.data.frame(distances)
colnames(allDist) <- c('longitude', 'latitude')


# Create objects with error lat/long and nearest contour lat/long

p1 <- cbind(errTrack$longitude, errTrack$latitude)
p2 <- cbind(allDist$longitude, allDist$latitude)

# Convert to Great Circle distance 

finalDist <- as.data.frame(distHaversine(p1, p2, r=6378137)/1000)
colnames(finalDist) <- 'distance'
finalDist <- finalDist %>% 
  mutate_if(is.numeric, round, digits = 2)

distValue <- mean(finalDist$distance)

proximity[i,a] <- distValue

} # end for all contour extracts
} # end for each row in track 

track$Proximity_land <- proximity$X3
track$Proximity_200m <- proximity$X1
track$Proximity_1000m <- proximity$X2

} # end for all tracks 

我知道这可能有点小众，但如果有人能够提供有关使用函数清理循环代码的一般方法的任何见解，或者如果有人可以将我引导到可能有帮助的资源，将不胜感激。同样，如果有人可以专门帮助加速/清理此代码，那将是惊人的！ （如果需要，轮廓文件可以是一个随机多边形，以便重现）。 我希望这个问题适合这个论坛，如果不适合，请见谅。

Answer 1

我同意您的评估，即可以通过使用某些功能来澄清代码。通过使用函数，您可以将大型、复杂的程序分解为可单独推理的可管理块。

关于程序中的循环，许多人发现地图比循环更清晰。它们本质上像在循环中那样迭代元素集合，但不必跟踪索引变量。 purrr 包提供了极好的地图集合和其他功能。

阅读这些主题的一些好资源包括https://rstudio-education.github.io/hopr/、https://r4ds.had.co.nz/和https://adv-r.hadley.nz/。

在下面的代码中，我尝试将一些代码提取到函数中，以期使控制流更易于遵循。由于我没有在实际数据上尝试过代码，因此如果不进行一些修复，它肯定无法工作，但希望它能给你一些想法。

calc_errors_psat <- function(long, lat) {
  calc_errTrack(long, lat, 0.53, 1.08)
}

calc_errors_argos <- function(long, lat) {
  calc_errTrack(long, lat, 0.12, 0.12)
}

calc_errTrack <- function(long, lat, long_offset, lat_offset) {
  # don't `meanx` and `meany` have the same as value as `long` and `lat`?
  meanx <- mean(long - long_offset, long + long_offset)
  meany <- mean(lat - lat_offset, lat + lat_offset)
  err_long <- rtruncnorm(n=10, a=long-long_offset, b=long+long_offset, meanx)
  err_lat <- rtruncnorm(n=10, a=lat-lat_offset, b=lat+lat_offset, meany)
  err <- data.frame(
    longitude = c(long, err_long),
    latitude  = c(lat, err_lat)
  )
  SpatialPoints(err)
}

calc_distValues <- function(errTrack, contour) {

  n <- length(errTrack) # 10 for 9 random samples + original location 
  distances <- data.frame(matrix(ncol = 2, nrow = n))

  for (e in seq_along(errTrack)) {
    distances[e,] <- coordinates(gNearestPoints(errTrack[e], contour))[2,]
  }

  allDist <- as.data.frame(distances)
  colnames(allDist) <- c('longitude', 'latitude')


  # Create objects with error lat/long and nearest contour lat/long

  p1 <- cbind(errTrack$longitude, errTrack$latitude)
  p2 <- cbind(allDist$longitude, allDist$latitude)

  # Convert to Great Circle distance 

  finalDist <- as.data.frame(distHaversine(p1, p2, r=6378137)/1000)
  colnames(finalDist) <- 'distance'
  finalDist <- finalDist %>% 
    mutate_if(is.numeric, round, digits = 2)

  mean(finalDist$distance)
}

find_err_fcn <- function(loc) {
  tagType <- dirname(dirname(dirname(loc)))
  if (tagType == "PSAT") {
    calc_errors_psat
  } else {
    calc_errors_argos
  }
}

# get the track file locations
dir <- 'C:/Users/Documents/PhD/Chapters/'
sfolder <- file.path(dir, 'Data/Tracks')
track_locs <- list.files(sfolder, full.names = TRUE)

# read in files and error functions into a data frame, and calculate the track
# errors
track_df <- tibble::tibble(
  track_list    = purrr::map(track_locs, read.csv),
  calc_err_fcns = purrr::map(track_locs, find_err_fcn),
  errTrack_list = purrr::map2(track_list, calc_err_fcns, function(x, f) f(x))
)

# calculate the track proximities distances
proximity_contours <- c(
  contour2 = readOGR(file.path(dir, 'QGIS/Base layers/2GEBCO_2020_Contour_200.gpkg')),
  contour1 = readOGR(file.path(dir, 'QGIS/Base layers/2GEBCO_2020_Contour_1000.gpkg')),
  land     = readOGR(file.path(dir, 'QGIS/Base layers/GEBCO_2020_Contour_0.gpkg'))
)

track_results <- purrr::map_dfc(
  .x = proximity_contours,
  .f = function(contour) purrr::map(
    .x      = track_df$errTrack_list,
    .f      = calc_distValue,
    contour = contour
  )
)