определяне на най-краткото разстояние между UTM точки в два набора от данни R

Опитвам се да намеря най-краткото разстояние между училищата и бреговата линия. Всички училища са в източен и северен формат, бреговата линия е съставена от точки, също в източен и северен формат.

Реших това, като имах цикъл, който минава през всяко училище и друг цикъл вътре в училищния цикъл, който сравнява местоположението на училището с всички точки на бреговата линия. Това е невероятно бавно, тъй като имам 40 000 училища и 180 000 точки на картата и знам, че никога не трябва да използвате цикли в R! Опитах се да събера следното:

Данни от теста:

schools <- structure(list(URN = c(100000L, 100008L, 100009L, 100010L,  100011L, 100012L), Easting = c(533498L, 530238L, 524888L, 529912L, 528706L,  528386L), Northing = c(181201L, 182761L, 185067L, 184835L, 186594L,  185209L)), .Names = c("URN", "Easting", "Northing"), row.names = c(NA,  6L), class = "data.frame")

coastline <- structure(list(Easting = c(219588.203816721, 219623.335092579,  219625.861360502, 219661.118975722, 219664.898582579, 219700.155464073 ), Northing = c(607325.869617586, 607324.434359255, 607386.276450707,  607384.83630279, 607477.377010103, 607475.937159766)), .Names = c("Easting", "Northing"), row.names = c(NA, 6L), class = "data.frame")

Кодът

for (sch in schools$URN){

  minimumDistance <- 500000

  SEasting <- schools %>% filter(URN == sch) %$% Easting
  SNorthing <- schools %>% filter(URN == sch) %$% Northing

  mindisance <- coastline %>% mutate(distance = 
             min(sqrt((SEasting - Easting)^2 +
                (SNorthing - Northing)^2))) %$% distance

  print(paste(sch, "minDistance = ", mindisance))
}

Но получавам резултат за всяка брегова точка:

[1] "100000 minDistance =  529243.315102678" "100000 minDistance =  529243.315102678"
[3] "100000 minDistance =  529243.315102678" "100000 minDistance =  529243.315102678"
[5] "100000 minDistance =  529243.315102678" "100000 minDistance =  529243.315102678"

Това, което бих искал е

100000 minDistance = 529243.315102678

Някаква идея какво правя грешно?


r loops dplyr
person pluke    schedule 12.06.2016    source източник

Отговори (1)


arrow_upward
1
arrow_downward

Превключете mutate на summarise:

for (sch in schools$URN){

  minimumDistance <- 500000

  SEasting <- schools %>% filter(URN == sch) %$% Easting
  SNorthing <- schools %>% filter(URN == sch) %$% Northing

  mindisance <- coastline %>% summarise(distance = 
                                       min(sqrt((SEasting - Easting)^2 +
                                                (SNorthing - Northing)^2)))
%$% distance

  print(paste(sch, "minDistance = ", mindisance))
}

[1] "100000 minDistance =  529243.315102678"
[1] "100008 minDistance =  526056.631790224"
[1] "100009 minDistance =  521044.965922041"
[1] "100010 minDistance =  524191.165239584"
[1] "100011 minDistance =  522059.567618869"
[1] "100012 minDistance =  522987.402491719"

summarise се използва за връщане на единична стойност като mean, sum или в този случай min. mutate се използва за промяна на всяка отделна стойност в колона и след това връщане на цялата колона. Мисля, че това обяснява защо оригиналният код се повтаря при командата print.

За да избегнете напълно for цикъла, можете да:

distances<-sapply(1:nrow(schools), function(x)
    with(schools[x,], min(sqrt((coastline$Easting-Easting)^2+  
                          (coastline$Northing-Northing)^2))))

paste(schools$URN, "minDistance = ", distances)

Подозирам, че това е бързо. Нека го тестваме върху по-голям набор от данни:

set.seed(400)
URN<-10000:19999
Easting1<-sample.int(533498, 10000)
Northing1<-sample.int(180000, 10000)
schools<-data.frame(URN, Easting = Easting1, Northing = Northing1)

Easting2<-sample.int(533498, 10000)
Northing2<-sample.int(180000, 10000)
coastline<-data.frame(Easting = Easting2, Northing = Northing2)

f1<- function() 
  for (sch in schools$URN){

    minimumDistance <- 500000

    SEasting <- schools %>% filter(URN == sch) %$% Easting
    SNorthing <- schools %>% filter(URN == sch) %$% Northing

    mindisance <- coastline %>% summarise(distance = 
                                            min(sqrt((SEasting - Easting)^2+
                                                       (SNorthing-   
                                             Northing)^2))) %$% distance
print(paste(sch, "minDistance = ", mindisance))
  }

f2<- function(){ 
  distances<-sapply(1:nrow(schools), function(x)
 with(schools[x,], min(sqrt((coastline$Easting-Easting)^2+ 
                       (coastline$Northing-Northing)^2))))

 paste(schools$URN, "minDistance = ", distances)
}

library(microbenchmark)
microbenchmark(f1(), f2(), times = 10)
##this takes a while to run

Unit: seconds
expr       min        lq     mean    median        uq       max neval
f1() 20.013022 20.387663 20.53804 20.625776 20.735973 20.763166    10
f2()  2.932491  2.971101  2.99707  3.004892  3.031679  3.044733    10

sapply() методът е ~6,8 пъти по-бърз.

person Bryan Goggin    schedule 12.06.2016
comment
Благодаря, страхотно е! - person pluke; 12.06.2016
comment
Ускори ли нещо? Сега трябва да свърши само 1/nrow() от работата на print(). - person Bryan Goggin; 12.06.2016
comment
значително, трябва да си накарам главата да мисля от гледна точка на матрици - person pluke; 13.06.2016
comment
Също така, има ли някакъв начин да се отърва от първия цикъл? - person pluke; 13.06.2016
comment
за да ви дам индикация за увеличаване на скоростта, версията за цикъл в цикъл щеше да отнеме 29 часа, тази версия отнема около 1 минута :) - person pluke; 15.06.2016
comment
Има ли начин да се покаже идентичността на най-близката точка на бреговата линия, вместо разстоянието? - person John L. Godlee; 27.02.2018