Find nearest bearing on compass going both directions; into existing formula

Question

Mandar has graciously written this code for me from this Q/A in r, how to assess the two vectors based on other vectors

names(df) <- c("a","b","c","d")
df_backup <- df
df$newcol <- NA

used <- c()
for (i in seq(1,length(df$a),1)){
  print("######## Separator ########")
  print(paste("searching right match that fits criteria for ",df$a[i],"in column 'a'",sep=""))
  valuea <- df[i,1]
  orderx <- order(abs(df$b-valuea))

  index=1
  while (is.na(df$newcol[i])) {
    j=orderx[index]
    if (df$b[j] %in% used){
      print(paste("passing ",df$b[j], "as it has already been used",sep=""))
      index=index+1
      next
    } else {
      indexb <- j
      valueb <- df$b[indexb]
      print(paste("trying ",valueb,sep=""))

      if (df$c[i] != df$d[indexb]) {
        df$newcol[i] <- df$b[indexb]
        print(paste("using ",valueb,sep=""))
        used <- c(used,df$b[indexb])
      } else {
        df$newcol[i] <- NA
        print(paste("cant use ",valueb,"as the column c (related to index in a) and d (related to index in b) values are matching",sep=""))
      }

      index=index+1
    }
  }
}

this is what my data look like

a   b   c   d
12.9722051  297.9117268 1   1
69.64816997 298.1908749 2   2
318.8794557 169.0386352 3   3
326.1762208 169.3201391 4   4
137.5400592 336.6595313 5   5
358.0600171 94.70890334 6   6
258.9282428 94.77530919 7   7
98.57513917 290.1983195 8   8
98.46303072 290.4078981 9   9
17.2276417  344.383796  10  10
316.6442074 148.786547  11  11
310.7370168 153.3287735 12  12
237.3270752 107.8397117 13  13
250.6538555 108.0570571 14  14
337.0954288 180.6311769 15  15
137.0336521 1.0294907   16  16
301.2277242 185.2062845 17  17
332.935301  185.9792236 18  18
340.841266  220.4043846 19  19

the values in column a and b are compass bearings. currently, the formula looks at a value in column a and compares it to all values in column b and finds the closest one. but what i realized i need it to do is look at a value in column b, but not only find the nearest value based on absolute difference, but also take into account that it is a compass bearing. for example: for the value in column a of 358.0600171 the current formula would return a value from column b of 344.383796, which is ~14 degrees away from 358.060171; however, the actual closest bearing value from column b should be 1.0294907 which is only 3 degrees away from 358.0600171. i would like to incorporate a function that that accounts for this compass bearing issue into the current formula: which does all my other needed evaluation, filtering, and column creation.

There a similar query here(Finding the closest difference between 2 degrees of a compass - Javascript), but I need assistance on whether the function will work in R, and how to incorporate it into the existing formula.

Answer 1

we can find the nearest compass bearings like this:

nearest = function(i,df){
  diff = abs(df[i, 1] - df[, 2])
  diff = pmin(diff, 360-diff)
  which.min(diff)
}

df$nearest_b = sapply(1:NROW(df), nearest, df[1:2])
df$nearest_a = sapply(1:NROW(df), nearest, df[2:1])

#            a          b nearest_b nearest_a
# 1   12.97221 297.911727        16        17
# 2   69.64817 298.190875         6        17
# 3  318.87946 169.038635         5         5
# 4  326.17622 169.320139         5         5
# 5  137.54006 336.659531        11        15
# 6  358.06002  94.708903        16         9
# 7  258.92824  94.775309         8         9
# 8   98.57514 290.198320         7        17
# 9   98.46303 290.407898         7        17
# 10  17.22764 344.383796        16        19
# 11 316.64421 148.786547         2         5
# 12 310.73702 153.328774         2         5
# 13 237.32708 107.839712        19         8
# 14 250.65386 108.057057        19         8
# 15 337.09543 180.631177         5         5
# 16 137.03365   1.029491        11         6
# 17 301.22772 185.206285         2         5
# 18 332.93530 185.979224         5         5
# 19 340.84127 220.404385        10        13

The data

df = read.table(text =
"a   b   c   d
12.9722051  297.9117268 1   1
69.64816997 298.1908749 2   2
318.8794557 169.0386352 3   3
326.1762208 169.3201391 4   4
137.5400592 336.6595313 5   5
358.0600171 94.70890334 6   6
258.9282428 94.77530919 7   7
98.57513917 290.1983195 8   8
98.46303072 290.4078981 9   9
17.2276417  344.383796  10  10
316.6442074 148.786547  11  11
310.7370168 153.3287735 12  12
237.3270752 107.8397117 13  13
250.6538555 108.0570571 14  14
337.0954288 180.6311769 15  15
137.0336521 1.0294907   16  16
301.2277242 185.2062845 17  17
332.935301  185.9792236 18  18
340.841266  220.4043846 19  19",
header = T)[,1:2]

Answer 2

The geosphere package has a few functions that incorporate distance between spherical points.

ftp://cran.r-project.org/pub/R/web/packages/geosphere/geosphere.pdf

I'm not sure it will be what you're looking for - you may have to figure out how the compass bearings in your data translate to the inputs you need.

I notice the problem you're having is that it treats absolute distance as numerical difference, not accounting for the fact that you should be resetting to 0 at 360. You might be able to account for this by writing a function that stipulates to sum (difference between the co-ordinate and 360) and (other co-ordinate).

Eg: - c1 is the input co-ordinate - c2 is the co-ordinate you're comparing it to

if c1 - c2 > 180 { (360 - c1) + c2 }

I don't fully understand what you're trying to do so not sure if this is right but hope it helps.

Answer 3

Check this code : Just changed how orderx is defined with ifelse Now if the abs difference between angles is > 180, then use the 360-difference (which is lower value); otherwise if the difference is already <=180 use the smaller difference itself

setwd("~/Desktop/")
df <- read.table("trial.txt",header=T,sep="\t")
names(df) <- c("a","B","C","D")
df_backup <- df
df$newcol <- NA

used <- c()
for (i in seq(1,length(df$a),1)){
  print("######## Separator ########")
  print(paste("searching right match that fits criteria for ",df$a[i],"in column 'a'",sep=""))
  valueA <- df[i,1]
  # orderx <- order(abs(df$B-valueA))
  orderx <- order(ifelse(360-abs(df$B-valueA) > 180, abs(df$B-valueA) ,360-abs(df$B-valueA)))

  index=1
  while (is.na(df$newcol[i])) {
    j=orderx[index]
    if (df$B[j] %in% used){
      print(paste("passing ",df$B[j], "as it has already been used",sep=""))
      index=index+1
      next
    } else {
      indexB <- j
      valueB <- df$B[indexB]
      print(paste("trying ",valueB,sep=""))

      if (df$C[i] != df$D[indexB]) {
        df$newcol[i] <- df$B[indexB]
        print(paste("using ",valueB,sep=""))
        used <- c(used,df$B[indexB])
      } else {
        df$newcol[i] <- NA
        print(paste("cant use ",valueB,"as the column C (related to index in A) and D (related to index in B) values are matching",sep=""))
      }

      index=index+1
    }
  }
}