In R, how do you classify your data into different classes based on certain standards?

Viewed 98

For example, I want to classify R1 based on R2. R1 is like

# A tibble: 5 x 2
    lon   lat
  <dbl> <dbl>
1     1     2
2     3     5
3     6     8
4     5    10
5     3     2

and R2 is like

# A tibble: 3 x 3
    lon   lat place
  <dbl> <dbl> <chr>
1     1     2 A    
2     3     6 B    
3     5     8 C 

R2 is like a standard. I want to find the corresponding place for my observations in R1. Suppose the 1st place in R1 is graded like:

  1. scores of A: (1-1)^2 + (2-2)^2 = 0
  2. scores of B: (1-3)^2 + (2-6)^2 = 20
  3. scores of C: (1-5)^2 + (2-8)^2 = 52 If the scores of any place may be smaller than 3, we classify this place into the class. The final result should be like this
# A tibble: 5 x 2
    lon   lat   place
  <dbl> <dbl>   <chr>
1     1     2   A
2     3     5   B
3     6     8   C
4     5    10   NA
5     3     2   NA
2 Answers

There might be a neater way to do this with some purrr mapping, but using a couple of loops instead could get you the desired results:

library(tidyverse)

## Create R1 and R2 as tibbles, with place as a row name
R1 <- tribble(~lon, ~lat,
              1,2,
              3,5,
              6,8,
              5,10,
              3,2)


R2 <- tribble(~lon, ~lat,~place,
              1,2,"A",
              3,6,"B",
              5,8,"C") %>% column_to_rownames(var = "place")


## Create a results tibble
results <- R1 %>% mutate(A = NaN, B = NaN, C = NaN, match = "NA")

## Function to calculate place scores
place_scores <- function(vec){
apply(R2,1,function(x) x-vec) %>% 
apply(.,2,function(x) x^2) %>% 
colSums() 
}

## Run function in a loop for each row in R1
for(i in 1:nrow(R1)){
  res <- place_scores(as.numeric(R1[i,]))
  results[i,3:5] <- res
}

## Run another loop to match the column with the lowest score and < 3
for(i in 1:nrow(results)){
  match <- ifelse(any( results[i,3:5] < 3), colnames(results[,3:5])[which.min(as.numeric(results[i,3:5]))], NA)
  results$match[i] <- match
}
results

# A tibble: 5 x 6
    lon   lat     A     B     C match
  <dbl> <dbl> <dbl> <dbl> <dbl> <chr>
1     1     2     0    20    52 A    
2     3     5    13     1    13 B    
3     6     8    61    13     1 C    
4     5    10    80    20     4 NA   
5     3     2     4    16    40 NA  

I also came up with a way to do this using for-loop:

class = R2$place
for (i in 1:length(R1$place)) 
{
dist = rep(0, length(R2$place))
for (j in 1:length(R2$place)) 
   {
      dist[j] = (R1[i, 1] - R2[j,1])^2 + (R1[i, 2] - R2[j, 2])^2
   }
R1$class[i] = class[which(dist <= 3)]
}
Related