我有一个带有lat和long的数据帧，我想将其转换为UTM。纬度和经度有不同的UTM区域。我有一个用于将单个区域转换为适当的UTM的脚本，但我如何创建一个循环，根据它们的区域将各种纬度和经度转换为UTM。在数据中，我有一列用于正确的区域。
数据
data <- structure(list(site_code = c("pa1", "pa2", "pa5", "pa7", "pa4",
"pa9", "pa11", "pa6", "pa12", "pa10", "pa3", "pa8", "tn1", "tn2",
"tn5", "tn4", "tn3", "vt1", "vt2", "vt8", "vt7", "vt4", "vt3",
"vt5", "vt6", "la2", "la1", "la4", "la3", "la5", "la6", "la7",
"nm19", "nm10", "nm8", "nm4", "nm11", "nm1", "nm2", "nm15", "nm13",
"nm14", "nm12", "nm6", "nm7", "nm3", "nm20", "nm5", "nm16", "nm18",
"nm17", "nm36", "nm35", "nm9", "la8", "nm21", "nm22", "nm23",
"nm24", "nm25", "nm26", "nm27", "nm28", "nm29", "nm30", "nm31",
"nm32", "nm33", "nm34"), region = c("pennsylvania", "pennsylvania",
"pennsylvania", "pennsylvania", "pennsylvania", "pennsylvania",
"pennsylvania", "pennsylvania", "pennsylvania", "pennsylvania",
"pennsylvania", "pennsylvania", "tennessee", "tennessee", "tennessee",
"tennessee", "tennessee", "vermont", "vermont", "vermont", "vermont",
"vermont", "vermont", "vermont", "vermont", "louisiana", "louisiana",
"louisiana", "louisiana", "louisiana", "louisiana", "louisiana",
"new mexico", "new mexico", "new mexico", "new mexico", "new mexico",
"new mexico", "new mexico", "new mexico", "new mexico", "new mexico",
"new mexico", "new mexico", "new mexico", "new mexico", "new mexico",
"new mexico", "new mexico", "new mexico", "new mexico", "new mexico",
"new mexico", "new mexico", "louisiana", "new mexico", "new mexico",
"new mexico", "new mexico", "new mexico", "new mexico", "new mexico",
"new mexico", "new mexico", "new mexico", "new mexico", "new mexico",
"new mexico", "new mexico"), site = c("wood lab pond", "rv pond",
"tryon-weber", "beaver", "cow pit", "david's pond", "church",
"tuttle pond", "black jack", "phelps pond", "hatchery", "vorisek pond",
"newt", "pine", "sink", "deer", "west", "camp johnson pond 1",
"camp johnson pond 2", "natural area close to vt01 and vt02",
"adjacent to sand bar state park", "camp ethan allen pond", "north beach pond",
"shelbourne bay", "shelbourne pond", "solomon lane", "kurthwood",
"horse head permanent", "kisatchie bayou", "horse head ephemeral",
"la6", "la7", "leasburg dam state park, bridge", "garcia well",
"johnson tank", "davie's playa- doug burkett", "cuchillo", "red tank",
"red tank 2", "bupu0039", "roadside ditch bude2026", "speamulti2237",
"2330scacou", "rouse tank", "avilas", "rhodes spring", "davie's playa",
"circle 7", "range road12", "doug's office", "culvert 0", "artesia",
"paseo del rio", "leasburg dam", "la8", "n. caballo lake", "n. caballo lake 2",
"fish well", "lm bar, 1443 tank - poss south seco tank", "1342 tank - possibly south seco tank",
"pague well", "n. seco well", "sissel tank", "polo tank", "n. caballo lake 3",
"percha dam state park", "southwell tank", "unid jornada tank",
"frog tank"), lat = c(41.569722, 41.691705, 41.593133, 41.665167,
41.672974, 41.621208, 41.650494, 41.638883, 41.665733, 41.691276,
41.643053, 41.712117, 35.35072, 35.343463, 35.40982, 35.42517,
35.41078, 44.507673, 44.515034, 44.498724, 44.627464, 44.496218,
44.493559, 44.400566, 44.376923, 31.700297, 31.484564, 31.46769,
31.444947, 31.320851, 31.255013, NA, NA, 32.739025, 33.090787,
32.355656, NA, 33.499471, 33.495826, 33.493784, 33.133323, 33.337197,
33.495381, 33.331613, 33.164875, 33.194709, NA, 33.169416, 33.507536,
NA, 32.991219, 33.050854, 33.151993, 32.487049, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA), long = c(-80.4525,
-80.50082, -80.356283, -80.51465, -80.513485, -80.469131, -80.423694,
-80.495117, -80.511781, -80.512482, -80.430097, -80.389028, -86.13993,
-86.129624, -86.06988, -86.07452, -86.07966, -73.162141, -73.162287,
-73.171326, -73.237832, -72.890135, -73.242776, -73.23624, -73.161736,
-92.970663, -93.174226, -93.147099, -93.093505, -93.134511, -93.24072,
NA, NA, -106.71321, -107.566088, -106.404037, NA, -106.359682,
-106.293403, -106.327882, -106.505509, -106.313692, -106.292815,
-107.64518, -107.61595, -106.696956, NA, -107.684043, -106.205415,
NA, -106.519744, -107.529161, -107.203096, -106.924443, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA), site_comments = c(NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, "Radium Springs Exit",
"Jornada", "Ladder Ranch", "White Sand Missile Range", "Ladder Ranch",
"White Sand Missile Range", "White Sand Missile Range", "White Sand Missile Range",
"White Sand Missile Range", "White Sand Missile Range", "White Sand Missile Range",
"Ladder Ranch", "Ladder Ranch", "White Sand Missile Range", "White Sand Missile Range",
"Ladder Ranch", "White Sand Missile Range", "Leesburg Dam", "White Sand Missile Range",
"Ladder Ranch", "Elephant Butte", "Leasburg Dam", NA, "Williamsburg",
"Williamsburg", "Ladder Ranch", "Ladder Ranch", "Ladder Ranch",
"Ladder Ranch", "Ladder Ranch", "Ladder Ranch", "Ladder Ranch",
"Williamsburg", "Caballo Lake", "Jornada", "Jornada", "Jornada"
), location = c("usa", "usa", "usa", "usa", "usa", "usa", "usa",
"usa", "usa", "usa", "usa", "usa", "usa", "usa", "usa", "usa",
"usa", "usa", "usa", "usa", "usa", "usa", "usa", "usa", "usa",
"usa", "usa", "usa", "usa", "usa", "usa", "usa", "usa", "usa",
"usa", "usa", "usa", "usa", "usa", "usa", "usa", "usa", "usa",
"usa", "usa", "usa", "usa", "usa", "usa", "usa", "usa", "usa",
"usa", "usa", "usa", "usa", "usa", "usa", "usa", "usa", "usa",
"usa", "usa", "usa", "usa", "usa", "usa", "usa", "usa"), utm_zone = c(17,
17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 16, 16, 16, 16, 16,
18, 18, 18, 18, 18, 18, 18, 18, 15, 15, 15, 15, 15, 15, NA, NA,
13, 13, 13, NA, 13, 13, 13, 13, 13, 13, 13, 13, 13, NA, 13, 13,
NA, 13, 13, 13, 13, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA)), row.names = c(NA, -69L), class = c("tbl_df",
"tbl", "data.frame"))
转换一个区域的脚本
v <- vect(data, c("long", "lat"), crs="+proj=longlat")
u <- terra::project(v, "+proj=utm +zone=23")
utm <- crds(u)
i <- which(!is.na(data$long))
data[i, c("utme", "utmn")] <- utm
data <- data %>%
select(!c(long, lat))
我认为这就是您想要的。使用utm_zone列也可以确定要转换的区域
这是一种直接、拆分、应用和组合的策略。有关更多详细信息，请参阅注释。
#split data by utm_zone
utmsplit <- split(data, data$utm_zone)
#apply function to each groupings
dfs <- lapply(utmsplit, function(dx){
utm_zone <- dx$utm_zone[1] #get utm zone for the group
project_string <- paste0("+proj=utm +zone=", utm_zone)
v <- vect(dx, c("long", "lat"), crs="+proj=longlat")
u <- terra::project(v, project_string)
utm <- crds(u)
#add new columns to data frame
cbind(dx, utm)
})
#combine individuals data frames back into one.
answer <- dplyr:bind_rows(dfs)