how to optimise my code to run on a Windows 2012 Server - r

Question

My code is running very slowly on my laptop and i have access to a windows 2012 server x64 with 256Gb ram.
I have the server set up running R and have this code working but 48 hours = 25%
From what i have learnt its due to only using one core.
Currently I'm exploring foreach loop but getting nowhere slowly
library("sp")
library("rgeos")
library("geosphere")
library("gdistance")
# Data
dna <- data.frame(cbind(rnorm(400) * 2 + 13, rnorm(400) + 48))
dna$ID <- seq.int(nrow(dna))
match <- data.frame(cbind(rnorm(4000) * 2 + 13, rnorm(4000) + 48))
match$ID <- seq.int(nrow(match))
##Set row id
RID2 <- 1
#create output table
tablelength <- print (nrow(dna))
match1 = data.frame( UPRN=rep(0, tablelength), Long=rep(0,tablelength), Lats=rep(0,tablelength), MatchID=rep(0,tablelength) , Longm=rep(0,tablelength), Latsm=rep(0,tablelength), distance=rep(0,tablelength))
#start loop
for(RID2 in dna[,3]) {
#Set UPRN and Exchange Name
Name <- paste(dna[RID2,3])
set1 <- data.frame(dna[RID2,1:2])
set2 <- data.frame(match[,1:2])
set1sp <- SpatialPoints(set2)
set2sp <- SpatialPoints(set1)
set1$ID <- apply(gDistance(set1sp, set2sp, byid=TRUE), 1, which.min)
ID <- paste(apply(gDistance(set1sp, set2sp, byid=TRUE), 1, which.min))
#insert Row
match1[RID2, ] = c(Name, set1[,1], set1[,2], paste(match[ID,3]), set2[ID,1], set2[ID,2], distVincentyEllipsoid(c(set1[,1], set1[,2]), c(set2[ID,1], set2[ID,2]), a=6378137, b=6356752.3142, f=1/298.257223563))
remove(set1,set2,set1sp,set2sp)
}
The output is what i am looking for but ideally with a sub 1 day runtime (currently at 8)

Answer 1

This works for me, and cuts calculation time (on your sample data) in half on my machine..
set.seed(123)
# Data
dna <- data.frame(cbind(rnorm(400) * 2 + 13, rnorm(400) + 48))
dna$ID <- seq.int(nrow(dna))
match <- data.frame(cbind(rnorm(4000) * 2 + 13, rnorm(4000) + 48))
match$ID <- seq.int(nrow(match))
###
library( sf )
library( data.table )
dna.sf <- st_as_sf( x = dna,
coords = c( "X1", "X2"),
crs = "+proj=longlat +datum=WGS84" )
match.sf <- st_as_sf( x = match,
coords = c( "X1", "X2"),
crs = "+proj=longlat +datum=WGS84" )
#create data.tables
setDT(dna)
setDT(match)
#add suffixes to identify columns later (after join)
setnames(dna, names(dna), paste0(names(dna),".dna"))
setnames(match, names(match), paste0(names(match),".match"))
#create distance matrix
m <- round( st_distance( dna.sf, match.sf ), digits = 0 )
colnames( m ) <- match.sf$ID
rownames( m ) <- dna.sf$ID
#get colname of min to nearest (remember, colname = match-ID ;-) )
dna$nearest <- apply( m, 1, which.min )
#get the min distance
dna$dist <- apply( m, 1, min )
#now left-join to get the coordinates of match, use data.table for speed
library( data.table )
result <- match[dna, on = c("ID.match==nearest") ]
The results seem to be the same as when using your 'old' method, but calculation time is roughly cut in half (7.5 -> 4 secs)

Answer 2

You can already get a good speed boost by simply optimizing the code and removing redundant parts. For example, this is more or less twice as fast on the test data, and is easily parallelizable.
library("sp")
library("rgeos")
library("geosphere")
library("gdistance")
# Data
dna <- data.frame(cbind(rnorm(400) * 2 + 13, rnorm(400) + 48))
dna$ID <- seq.int(nrow(dna))
match <- data.frame(cbind(rnorm(40000) * 2 + 13, rnorm(40000) + 48))
match$ID <- seq.int(nrow(match))
##Set row id
RID2 <- 1
#create output table
tablelength <- nrow(dna)
matchlist <- list()
set2 <- match[,1:2]
set1sp <- SpatialPoints(set2)
for(RID2 in dna[,3]) {
set1 <- dna[RID2,1:2]
set2sp <- SpatialPoints(set1)
ID <- which.min(gDistance(set1sp, set2sp, byid=TRUE))
#insert Row
matchlist[[RID2]] = data.frame(UPRN = dna[RID2,3],
Long = set1[,1],
Lats = set1[,2],
matchid = match[ID,3],
Longm = set2[ID,1],
Latsm = set2[ID,1],
distance = distVincentyEllipsoid(set1, set2[ID,],
a=6378137, b=6356752.3142, f=1/298.257223563))
}
match1 <- data.table::rbindlist(matchlist)

Answer 3

thanks you all for your input i will be reading the different styles to further my R learning's.
I have used a solution posted from the reddit thread i also made at the same time.
require(foreach)
require(doParallel)
cl <- makeCluster(4)
registerDoParallel(cl)
temp <- foreach(I = 1:nrow(dna),.combine = "c", .packages = c("rgeos","sp")) %dopar% {
return(c(which.min(
gDistance(
SpatialPoints(data.frame(dna[I,1:2]))
, SpatialPoints(data.frame(match[,1:2]))
, byid=TRUE
))))
}
https://old.reddit.com/r/rstats/comments/aebamb/how_do_i_use_all_the_cores_on_a_server_to_match/
Again thank you for the help :-D