aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

new files

Browse source
This commit is contained in:
Ingy döt Net 2013-04-10 12:38:42 -07:00
parent 3af7344581
commit 86c034bb8b
1364 changed files with 21352 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

30
Task/Closest-pair-problem/R/closest-pair-problem-1.r Normal file
View file

@ -0,0 +1,30 @@
closest_pair_brute <-function(x,y,plotxy=F) {
xy = cbind(x,y)
cp = bruteforce(xy)
cat("\n\nShortest path found = \n From:\t\t(",cp[1],',',cp[2],")\n To:\t\t(",cp[3],',',cp[4],")\n Distance:\t",cp[5],"\n\n",sep="")
if(plotxy) {
plot(x,y,pch=19,col='black',main="Closest Pair", asp=1)
points(cp[1],cp[2],pch=19,col='red')
points(cp[3],cp[4],pch=19,col='red')
}
distance <- function(p1,p2) {
x1 = (p1[1])
y1 = (p1[2])
x2 = (p2[1])
y2 = (p2[2])
sqrt((x2-x1)^2 + (y2-y1)^2)
}
bf_iter <- function(m,p,idx=NA,d=NA,n=1) {
dd = distance(p,m[n,])
if((is.na(d) || dd<=d) && p!=m[n,]){d = dd; idx=n;}
if(n == length(m[,1])) { c(m[idx,],d) }
else bf_iter(m,p,idx,d,n+1)
}
bruteforce <- function(pmatrix,n=1,pd=c(NA,NA,NA,NA,NA)) {
p = pmatrix[n,]
ppd = c(p,bf_iter(pmatrix,p))
if(ppd[5]<pd[5] || is.na(pd[5])) pd = ppd
if(n==length(pmatrix[,1])) pd
else bruteforce(pmatrix,n+1,pd)
}
}

20
Task/Closest-pair-problem/R/closest-pair-problem-2.r Normal file
View file

@ -0,0 +1,20 @@
closestPair<-function(x,y)
{
distancev <- function(pointsv)
{
x1 <- pointsv[1]
y1 <- pointsv[2]
x2 <- pointsv[3]
y2 <- pointsv[4]
sqrt((x1 - x2)^2 + (y1 - y2)^2)
}
pairstocompare <- t(combn(length(x),2))
pointsv <- cbind(x[pairstocompare[,1]],y[pairstocompare[,1]],x[pairstocompare[,2]],y[pairstocompare[,2]])
pairstocompare <- cbind(pairstocompare,apply(pointsv,1,distancev))
minrow <- pairstocompare[pairstocompare[,3] == min(pairstocompare[,3])]
if (!is.null(nrow(minrow))) {print("More than one point at this distance!"); minrow <- minrow[1,]}
cat("The closest pair is:\n\tPoint 1: ",x[minrow[1]],", ",y[minrow[1]],
"\n\tPoint 2: ",x[minrow[2]],", ",y[minrow[2]],
"\n\tDistance: ",minrow[3],"\n",sep="")
c(distance=minrow[3],x1.x=x[minrow[1]],y1.y=y[minrow[1]],x2.x=x[minrow[2]],y2.y=y[minrow[2]])
}

18
Task/Closest-pair-problem/R/closest-pair-problem-3.r Normal file
View file

@ -0,0 +1,18 @@
closest.pairs <- function(x, y=NULL, ...){
# takes two-column object(x,y-values), or creates such an object from x and y values
if(!is.null(y)) x <- cbind(x, y)
distances <- dist(x)
min.dist <- min(distances)
point.pair <- combn(1:nrow(x), 2)[, which.min(distances)]
cat("The closest pair is:\n\t",
sprintf("Point 1: %.3f, %.3f \n\tPoint 2: %.3f, %.3f \n\tDistance: %.3f.\n",
x[point.pair[1],1], x[point.pair[1],2],
x[point.pair[2],1], x[point.pair[2],2],
min.dist),
sep="" )
c( x1=x[point.pair[1],1],y1=x[point.pair[1],2],
x2=x[point.pair[2],1],y2=x[point.pair[2],2],
distance=min.dist)
}

36
Task/Closest-pair-problem/R/closest-pair-problem-4.r Normal file
View file

@ -0,0 +1,36 @@
x = (sample(-1000.00:1000.00,100))
y = (sample(-1000.00:1000.00,length(x)))
cp = closest.pairs(x,y)
#cp = closestPair(x,y)
plot(x,y,pch=19,col='black',main="Closest Pair", asp=1)
points(cp["x1.x"],cp["y1.y"],pch=19,col='red')
points(cp["x2.x"],cp["y2.y"],pch=19,col='red')
#closest_pair_brute(x,y,T)
Performance
system.time(closest_pair_brute(x,y), gcFirst = TRUE)
Shortest path found =
From: (32,-987)
To: (25,-993)
Distance: 9.219544
user system elapsed
0.35 0.02 0.37
system.time(closest.pairs(x,y), gcFirst = TRUE)
The closest pair is:
Point 1: 32.000, -987.000
Point 2: 25.000, -993.000
Distance: 9.220.
user system elapsed
0.08 0.00 0.10
system.time(closestPair(x,y), gcFirst = TRUE)
The closest pair is:
Point 1: 32, -987
Point 2: 25, -993
Distance: 9.219544
user system elapsed
0.17 0.00 0.19

88
Task/Closest-pair-problem/R/closest-pair-problem-5.r Normal file
View file

@ -0,0 +1,88 @@
closest.pairs.bruteforce <- function(x, y=NULL)
{
if (!is.null(y))
{
x <- cbind(x,y)
}
d <- dist(x)
cp <- x[combn(1:nrow(x), 2)[, which.min(d)],]
list(p1=cp[1,], p2=cp[2,], d=min(d))
}
closest.pairs.dandc <- function(x, y=NULL)
{
if (!is.null(y))
{
x <- cbind(x,y)
}
if (sd(x[,"x"]) < sd(x[,"y"]))
{
x <- cbind(x=x[,"y"],y=x[,"x"])
swap <- TRUE
}
else
{
swap <- FALSE
}
xp <- x[order(x[,"x"]),]
.cpdandc.rec <- function(xp,yp)
{
n <- dim(xp)[1]
if (n <= 4)
{
closest.pairs.bruteforce(xp)
}
else
{
xl <- xp[1:floor(n/2),]
xr <- xp[(floor(n/2)+1):n,]
cpl <- .cpdandc.rec(xl)
cpr <- .cpdandc.rec(xr)
if (cpl$d<cpr$d) cp <- cpl else cp <- cpr
cp
}
}
cp <- .cpdandc.rec(xp)
yp <- x[order(x[,"y"]),]
xm <- xp[floor(dim(xp)[1]/2),"x"]
ys <- yp[which(abs(xm - yp[,"x"]) <= cp$d),]
nys <- dim(ys)[1]
if (!is.null(nys) && nys > 1)
{
for (i in 1:(nys-1))
{
k <- i + 1
while (k <= nys && ys[i,"y"] - ys[k,"y"] < cp$d)
{
d <- sqrt((ys[k,"x"]-ys[i,"x"])^2 + (ys[k,"y"]-ys[i,"y"])^2)
if (d < cp$d) cp <- list(p1=ys[i,],p2=ys[k,],d=d)
k <- k + 1
}
}
}
if (swap)
{
list(p1=cbind(x=cp$p1["y"],y=cp$p1["x"]),p2=cbind(x=cp$p2["y"],y=cp$p2["x"]),d=cp$d)
}
else
{
cp
}
}
# Test functions
cat("How many points?\n")
n <- scan(what=integer(),n=1)
x <- rnorm(n)
y <- rnorm(n)
tstart <- proc.time()[3]
cat("Closest pairs divide and conquer:\n")
print(cp <- closest.pairs.dandc(x,y))
cat(sprintf("That took %.2f seconds.\n",proc.time()[3] - tstart))
plot(x,y)
points(c(cp$p1["x"],cp$p2["x"]),c(cp$p1["y"],cp$p2["y"]),col="red")
tstart <- proc.time()[3]
cat("\nClosest pairs brute force:\n")
print(closest.pairs.bruteforce(x,y))
cat(sprintf("That took %.2f seconds.\n",proc.time()[3] - tstart))