Function returns 0x0 table - r

I have a function to compute latitude and longitude points in order to create a "ring" around a center location. The problem is that the results print to the screen but are not stored anywhere. My function creates a dataframe with 0 columns and 0 rows. I want to be able to take these coordinates and use them elsewhere. I would like to be able to nest this function as well, but I can't really nest it when it doesn't return anything.
My end goal is to create kml code. I already have the kml code but need to repeat it many times. The kml code creates radius rings, fills them with color, and adds a name for the place. I want to generate the files automatically by using a list of locations in lat/lon.
My question is, how can I get this function to return the list of coordinates that I want so that I may paste them in the kml code accordingly? I can get it to loop using adply and get printed results for the 3 coordinates, but nothing is created.
I am also quite new to coding, please be gentle. Thanks in advance.
make.ring.file=function(dist,df)
{
R = 6378.14 #Radius of the Earth
d = dist*1.609344 #Distance of ring radius in km
lat1 = df$lat*(pi/180) #Current lat point converted to radians
lon1 = df$lon*(pi/180) #Current lon point converted to radians
num3=0
index=seq(from=0,to=360,by=120)
bear=NULL
lat=NULL
lon=NULL
z=NULL
coordlist=NULL
for(n in 1:length(index))
{
bear[n]=index[n]*(pi/180)
lat[n]=(asin(sin(lat1)*cos(d/R) + cos(lat1)*sin(d/R)*cos(bear[n])))*(180/pi)
lon[n]=(lon1 + atan2(sin(bear[n])*sin(d/R)*cos(lat1),
cos(d/R)-sin(lat1)*sin(lat[n]*(pi/180))))*(180/pi)
z[n]=0
coordlist[n]=paste(lon[n],lat[n],z[n],sep=",")
}
return(data.frame(cat(coordlist,"\n","\n")))
}
> head(x1)
lat lon
1 38.86095 -86.51672
2 30.63275 -84.41614
3 31.53697 -87.88780
> results=adply(x1,1,make.ring.file,dist=30)
-86.51672,39.2946592897837,0 -86.0358241901732,38.6431079084023,0 -86.9976158098268,38.6431079084023,0 -86.51672,39.2946592897837,0
-84.41614,31.0664592897837,0 -83.9805971533182,30.4151694949636,0 -84.8516828466818,30.4151694949636,0 -84.41614,31.0664592897837,0
-87.8878,31.9706792897837,0 -87.4481292235866,31.3193631233201,0 -88.3274707764134,31.3193631233201,0 -87.8878,31.9706792897837,0
> str(results)
'data.frame': 0 obs. of 0 variables
> is.data.frame(results)
[1] TRUE

I think this is what you want:
make.ring.file=function(dist,df)
{
R = 6378.14 #Radius of the Earth
d = dist*1.609344 #Distance of ring radius in km
lat1 = df$lat*(pi/180) #Current lat point converted to radians
lon1 = df$lon*(pi/180) #Current lon point converted to radians
num3=0
index=seq(from=0,to=360,by=120)
bear=NULL
lat=NULL
lon=NULL
z=NULL
coordlist=NULL
for(n in 1:length(index))
{
bear[n]=index[n]*(pi/180)
lat[n]=(asin(sin(lat1)*cos(d/R) + cos(lat1)*sin(d/R)*cos(bear[n])))*(180/pi)
lon[n]=(lon1 + atan2(sin(bear[n])*sin(d/R)*cos(lat1),
cos(d/R)-sin(lat1)*sin(lat[n]*(pi/180))))*(180/pi)
z[n]=0
coordlist[n]=paste(lon[n],lat[n],z[n],sep=",")
}
return(data.frame(out=paste(coordlist,collapse=" ")))
}
The key addition is:
return(data.frame(out=paste(coordlist,collapse=" ")))
The function cat, prints to console, so you can't assign it to anything - you were merely making an empty data.frame and printing.
The paste command works by pasting together the 4 lines of coordlist, with a separator of " ". You can modify this as required for your downstream code.

Related

R - graphics cross lines

I am with this doubt, but honestly I do not know if the solution really exists in R.
I have a graph x/y, and I want to draw two straight lines, (1) from the x-axis to the data, and another (2) from the y-axis to the data. Line 1, I have the value of it, would be the tertile of my data. The question is, how to find the exact point at which the line intersects the given and plot by following the y-axis?
I have already tried, by the position of the x-axis, to use the same position for y. This even works for some data, but not all (since the values ​​do not always match).
Here is my example
ob<-c(77.89824, 170.36929, 90.88129, 141.22368, 174.07871,
106.51393, 94.32576, 85.31712, 78.95808, 222.30143, 115.25760,
85.84704, 165.33504, 72.06912, 38.94912, 90.88129, 167.18976,
125.85600, 141.22367, 104.65922, 131.95009, 81.07777,
64.12032,130.36032, 89.29152, 65.97504, 40.27392, 64.38529,
113.40288)
tm<-c(38.94912, 40.27392, 64.12032, 64.38529, 65.97504, 72.06912,
77.89824, 78.95808, 81.07777, 85.31712, 85.84704, 89.29152,
90.88129, 94.32576, 104.65922, 106.51393, 113.40288, 115.25760,
125.85600, 130.36032, 131.95009, 141.22367, 141.22368, 165.33504,
167.18976, 170.36929, 174.07871)
bs<-c(0.96523390, 0.93066061, 0.89634466, 0.86213300, 0.82769878,
0.79311455, 0.75831596, 0.72311471, 0.68800759, 0.65245482,
0.61700818, 0.58163643, 0.51021060, 0.47393336, 0.43788203,
0.40203755, 0.36614804, 0.33059801, 0.29408090, 0.25820874,
0.22265365, 0.18803136, 0.15444785, 0.11931985, 0.08411248,
0.05098459, 0.01957279)
prc<-c(0.956974397, 0.914559074, 0.872836231, 0.831624652,
0.790544222, 0.749700646, 0.709038330, 0.668364230, 0.628275180,
0.588180704, 0.548730882, 0.509909531, 0.433282681, 0.395329802,
0.358306283, 0.322222487, 0.286868665, 0.252670119, 0.218461386,
0.185847964, 0.154593177, 0.125303855, 0.098121311, 0.071199383,
0.046104574, 0.024746731, 0.007529233)
plot(tm,bs,type="l",col="red")
lines(tm,prc,col="black")
tinf<-quantile(ob,prob=1/3)
tsup<-quantile(ob,prob=2/3)
idxinf<-which(tm>=(tinf-5) & tm<=(tinf+5))
infgrafico<-mean(prc[idxinf])
idxsup<-which(tm>=(tsup-5) & tm<=(tsup+5))
supgrafico<-mean(prc[idxsup])
segments(tinf,0.03, tinf,infgrafico,col='black',lty=3,lwd=1)
segments(min(tm),infgrafico,
tinf,infgrafico,col='black',lty=3,lwd=1)
text(tinf,cex=1,y=0,col="black",font=2,"T1")
segments(tsup,0.03, tsup,supgrafico,col='black',lty=3,lwd=1)
segments(min(tm),supgrafico,
tsup,supgrafico,col='black',lty=3,lwd=1)
text(tsup,cex=1,y=0,col="black",font=2,"T2")
But this is it, sometimes the values ​​are not corresponding and are not found, causing the straight lines do not cross in the value of the data. And yes, I would need something more automated as possible, as I have to save those values ​​on a table, and could not do it on the hand / trial and error one by one.
Thanks!
EDITED AFTER ONE ANSWER
TavoGLC or who wants, can you help in one more think? I have problems in some cases of my data.
tm <-c (54.05184, 67.29985, 70.86991, 78.42816, 80.84780, 80.54784, 80.81280, 81.8774, 89.82144, 89.82144, 90.81314, 90.35136, 92.20607, 92.47104, 97.50528, 97.77025, 99.09504, 99.88993, 100.41985, 100.94976, 101.74465, 102.27456, 105.45408 , 105.71905, 116.05248, 118.43713, 122.94144, 125.06112, NA)
prc <-c (0.9454304, 0.9604309, 0.9604309, 0.9608306, 0.9608306, 0.9608309, 0.9608309, 0.9608309, 0.9604309, 0.9605930, , 0.4163839, 0.3624935, 0.3041409, 0.2327866, 0.1079731, NA)
tercil <-89.821
plot (tm, prc, type = "l")
abline (v = 89.821, col = "red")
Considering that the line ('' abline (h = ...) '') has a very large range of location, when I do the procedure of "MakeLineCoords" obtaining values ​​of "2.627424", not agreeing with my data (max=1). I have a series of tm and prc data of [360,181,29], this example above is one of the errors I have cut. But if you want I can send you the complete test data.
This is the adaptation I made to work here.
yTinf = array (NA, c (360,181,29))
xTinf = array (NA, c (360,181,29))
for (i in 1: 360) {
for (j in 1: 181)
for (k in 1:29)
yTinf [i, j, k] <- tercil [i, j, k]
xTinf [i, j, k] <- MakeLineCoords (prc [i, j,], tm [i, j,], yTinf [i, j, k])
}}}
Even so, it presents some values ​​greater than 1 and some extrapolated, in the order of 2000 and 3000. Which from what I realized, it would be due to the above problem, where xTinf contains some correct values.
Thank you so much!
You just have to create a function that finds the closest point in the data and make an interpolation from that point.
MakeLineCoords <- function(Xvals,Yvals,targetPoint) {
x <- vector(mode="numeric", length=length(Yvals))
for(k in 1:length(Xvals)){
x[k]<-(Yvals[k]-targetPoint)^2
}
mL=which.min(x)
xVal=Xvals[mL]+(targetPoint-Yvals[mL])*((Xvals[mL+1]-Xvals[mL])/(Yvals[mL+1]-Yvals[mL]))
return(xVal)
}
Then you can define a target value to be found and create the coordinates for the lines in the plot.
yTarget<-0.25
xTarget<-MakeLineCoords(tm,bs,yTarget)
plot(tm,bs,type="l",col="red")
segments(xTarget,0.0,xTarget,yTarget,col='black',lty=3,lwd=1)
segments(min(tm),yTarget,xTarget,yTarget,col='black',lty=3,lwd=1)
By using your example data i get the following. Hope it helps
tinf<-quantile(ob,prob=1/3)
yTarget<-tinf
xTarget<-MakeLineCoords(bs,tm,yTarget)
plot(tm,bs,type="l",col="red")
segments(yTarget,0.0,yTarget,xTarget,col='black',lty=3,lwd=1)
segments(min(tm),xTarget,yTarget,xTarget,col='black',lty=3,lwd=1)

R: Update/generate variables without loop

How can I generate or update variables without using a loop? mutate doesn't work here (at least I don't know how to get it to work for this problem) because I need to calculate stuff from multiple rows in another data set.
I'm supposed to replicate the regression results of an academic paper, and I'm trying to generate some variables required in the regression. The following is what I need.
I have 2 relevant data sets for this question, subset (containing
geocoded residential property transactions) and sch_relocs (containing the date
of school relocation events as well as their locations)
I need to calculate the distance between each residential property and the nearest (relocated) school
If the closest school is one that relocated to the area near the residential property, the dummy variable new should be 1 (if the school relocated away from the area, then new should be 0)
If the relocated school moved only a small distance, and a house is within the overlapping portion of the respective 2km radii around the school locations, the dummy variable overlap should be 1, otherwise 0
If the distance to the nearest school is <= 2km, the dummy variable in_zone should be 1. If the distance is between 2km and 4km, these transactions are considered controls, and hence in_zone should be 0. If the distance is greater than 4km, I should drop the observations from the data
I have tried to do this using a for loop, but it's taking ages to run (it's still not done running after one night), so I need a better way to do it. Here's my code (very messy, I think the above explanation is a lot easier if you want to figure out what I'm trying to do.
for (i in 1:as.integer(tally(subset))) {
# dist to new sch locations
for (j in 1:as.integer(tally(sch_relocs))) {
dist = distHaversine(c(subset[i,]$longitude, subset[i,]$latitude),
c(sch_relocs[j,]$new_lon, sch_relocs[j,]$new_lat)) / 1000
if (dist < subset[i,]$min_dist_new) {
subset[i,]$min_dist_new = dist
subset[i,]$closest_new_sch = sch_relocs[j,]$school_name
subset[i,]$date_new_loc = sch_relocs[j,]$date_reloc
}
}
# dist to old sch locations
for (j in 1:as.integer(tally(sch_relocs))) {
dist = distHaversine(c(subset[i,]$longitude, subset[i,]$latitude),
c(sch_relocs[j,]$old_lon, sch_relocs[j,]$old_lat)) / 1000
if (dist < subset[i,]$min_dist_old) {
subset[i,]$min_dist_old = dist
subset[i,]$closest_old_sch = sch_relocs[j,]$school_name
subset[i,]$date_old_loc = sch_relocs[j,]$date_reloc
}
}
# generate dummy "new"
if (subset[i,]$min_dist_new < subset[i,]$min_dist_old) {
subset[i,]$new = 1
subset[i,]$date_move = subset[i,]$date_new_loc
}
else if (subset[i,]$min_dist_new >= subset[i,]$min_dist_old) {
subset[i,]$date_move = subset[i,]$date_old_loc
}
# find overlaps
if (subset[i,]$closest_old_sch == subset[i,]$closest_new_sch &
subset[i,]$min_dist_old <= 2 &
subset[i,]$min_dist_new <= 2) {
subset[i,]$overlap = 1
}
# find min dist
subset[i,]$min_dist = min(subset[i,]$min_dist_old, subset[i,]$min_dist_new)
# zoning
if (subset[i,]$min_dist <= 2) {
subset[i,]$in_zone = 1
}
else if (subset[i,]$min_dist <= 4) {
subset[i,]$in_zone = 0
}
else {
subset[i,]$in_zone = 2
}
}
Here's how the data sets look like (just the relevant variables)
subset data set with desired result (first 2 rows):
sch_relocs data set (full with only relevant columns)

Find specific point between 2 points - three.js

How can I find a point ( C (x,y,z) ) between 2 points ( A(x,y,z) , B(x,y,z) ) in a thgree.js scene?
I know that with this: mid point I can find the middle point between them, but I don't want the middle point, I want to find the point which is between them and also has distance a from the A point?
in this picture you can see what I mean :
Thank you.
Basically you need to get the direction vector between the two points (D), normalize it, and you'll use it for getting the new point in the way: NewPoint = PointA + D*Length.
You could use length normalized (0..1) or as an absolute value from 0 to length of the direction vector.
Here you can see some examples using both methods:
Using absolute value:
function getPointInBetweenByLen(pointA, pointB, length) {
var dir = pointB.clone().sub(pointA).normalize().multiplyScalar(length);
return pointA.clone().add(dir);
}
And to use with percentage (0..1)
function getPointInBetweenByPerc(pointA, pointB, percentage) {
var dir = pointB.clone().sub(pointA);
var len = dir.length();
dir = dir.normalize().multiplyScalar(len*percentage);
return pointA.clone().add(dir);
}
See it in action: http://jsfiddle.net/8mnqjsge/
Hope it helps.
I know the question is for THREE.JS and I end up looking for something similar in Babylon JS.
Just in case if you are using Babylon JS Vector3 then the formula would translate to:
function getPointInBetweenByPerc(pointA, pointB, percentage) {
var dir = pointB.clone().subtract(pointA);
var length = dir.length();
dir = dir.normalize().scale(length *percentage);
return pointA.clone().add(dir);
}
Hope it help somebody.
This is known as lerp between two points
e.g. in Three:
C = new Three.Vector3()
C.lerpVectors(A, B, a)
also in generic this is just a single lerp (linear interpolation) math (basically (a * t) + b * (1 - t)) on each axis. Lerp can be described as follows:
function lerp (a, b, t) {
return a + t * (b - a)
}
in your case (see above) :
A = {
x: lerp(A.x, B.x, a),
y: lerp(A.y, B.y, a),
z: lerp(A.z, B.z, a)
}

R - Arrays with variable dimension

I have a weird question..
Essentially, I have a function which takes a data frame of dimension Nx(2k) and transforms it into an array of dimension Nx2xk. I then further use that array in various locations in the function.
My issue is this, when k == 2, I'm left with a matrix of degree Nx2, and even worse, if N = 1, I'm stuck with a matrix of degree 1x2.
I would like to write myArray[thisRow,,] to select that slice of the array, but this falls short for the N = 1, k = 2 case. I tried myArray[thisRow,,,drop = FALSE] but that gives an 'incorrect number of dimensions' error. This same issue arrises for the Nx2 case.
Is there a work around for this issue, or do I need to break my code into cases?
Sample Code Shown Below:
thisFunction <- function(myDF)
{
nGroups = NCOL(myDF)/2
afMyArray = myDF
if(nGroups > 1)
{
afMyArray = abind(lapply(1:nGroups, function(g){myDF[,2*(g-1) + 1:2]}),
along = 3)
}
sapply(1:NROW(myDF),
function(r)
{
thisSlice = afMyArray[r,,]
*some operation on thisSlice*
})
}
Thanks,
James

nested if statment in R

I'm trying to implement following thing in R, but I'm new in R and my code doesn't work.
I have matrix A, I did coordinates changes .
I want to write two function:
1) give the element of matrix, given coordinates
2) give the coordinates given number.
the pseudo code is right, the only problem is my syntax. can somebody correct it ?
f<- as.numeric(readline(prompt="Please enter 10 to get coordinate of number,and 20 to get the number > "));
if(p==10){
# give the number, given coordinates
i<- as.numeric(readline(prompt="Pleae enter i cordinate > "));
j<- as.numeric(readline(prompt="Pleae enter j cordinate > "));
if (i>0&j<0) return A[5+i,5+j]
if (i>0&j>0) return A[5+i,5+j]
if (i<0&j>0) return A[5+i,5-j]
if (i<0&j<0) return A[5+i,5-j]
}else if (p==20){
#give the cordinate, given number
coordinate <- which(A==number)
[i,j]<-A[2-coordinate[0],coordinate[1]-2]
}
}
Warning: what if i or j is equal to zero? Next, make a single variable which is the decimal representation of binary i,j, That is,
if(p==10){
x <- (i>0) + 2*(j>0) +1
# x takes on values 1 thru 5. This is because switch requires nonnegative integer
switch(x,
return A[5+i,5+j],
return A[5+i,5+j],
return A[5+i,5+j],
return A[5+i,5+j]) # change the +/- indices as desired
}else{
#etc.
And, finally, you should make this a function, not a collection of commands.
Edit - I skipped this before, but: you cannot call an index of 0 so you need to fix a number of things in the line [i,j]<-A[2-coordinate[0],coordinate[1]-2]
The syntax is as follows:
x <- 4
if (x == 1 | x == 2) print("YES")

Resources