Минимальная разница на основе группового индекса на двух фреймах данных

Question

у меня два фрейма данных

A
            X1     Year_month
1          19.3945   1999_1
2          19.379    1999_1
3          19.2073   1999_1
4          19.267    2000_1
5          18.760    2000_1
6          19.3505   2000_1

и B

 Longitude   Year_month      CHL
1   12.3125     1999_1    12.70245
2    12.375     1999_1    12.63853
3   12.4375     1999_1    12.58700
4      12.5     2000_1    12.61019
5   12.5625     2000_1    12.75727
6    12.625     2000_1    13.06914

Я хотел бы рассчитать минимальную разницу между каждым значением A$X1 и всеми значениями B$Longitude на основе группового индекса Year_month и сообщить в новом столбце A значение B$CHL

Скажем, когда A$X1, минус каждое значение B$longitude, значения для значений, для той же группы Year_month - это минимальная разница, я помещаю в столбец A$res значения B$CHL Пример для первой строки df A:

A[1,1]-B[1,1]
A[1,1]-B[2,1]   
A[1,1]-B[3,1] ---> this is the minimum difference

в столбце A$res Я положил результат 12,58 (значение B[3,3]) и так далее для каждой строки A$X1

I tried this code: 
A$res<- as.data.frame(lapply(A, function(x){
  if(as.numeric(as.character(A$Year_month)) == as.numeric(as.character(B$Year_month))){
    return(B$CHL[unlist(lapply(as.numeric(as.character(B$Longitude)), function(t) which.min(abs(A$X1-t))))])
  } else{
    return(NA)
  }
}))

Но у меня есть ошибка:

Error in if (as.numeric(as.character(A$Year_month)) == as.numeric(as.character(B$Year_month))) { : 
  missing values where is required TRUE/FALSE
Furthermore Warning messages:
1: In FUN(X[[i]], ...) :  NA for coercion
2: In FUN(X[[i]], ...) : NA for coercion
3: In if (as.numeric(as.character(A$Year_month)) == as.numeric(as.character(B$Year_month))) { :
  the condition of length > 1 only the first element is used

Есть идеи ???

P.S .:

sapply(A,class)
        X1 Year_month 
  "factor"   "factor" 

sapply(B,class)
 Longitude Year_month        CHL 
  "factor"   "factor"  "numeric"

Answer 1

Избегайте зацикливания, поскольку ваши потребности в основном основаны на множестве вычислений фреймов данных (агрегированный уровень соединен с единичным уровнем). В частности, рассмотрим merge и aggregate, а затем merge снова:

# MERGE THEN CALCULATE ROW-WISE DIFFERENCE
mdf <- within(merge(dfA, dfB, by="Year_month"), {
        Res <- X1 - Longitude
})

# AGGREGATE TO FIND MINIMUM RES
aggdf <- aggregate(Res ~ Year_month + X1, mdf, min)

# MERGE AGGREGATION BACK TO UNIT LEVEL BY SAME COLUMNS
final_df <- merge(aggdf, mdf, by=c("Year_month", "Res", "X1"))  #by ARG IS REDUNDANT
final_df
#   Year_month    Res      X1 Longitude      CHL
# 1     1999_1 6.7698 19.2073   12.4375 12.58700
# 2     1999_1 6.9415 19.3790   12.4375 12.58700
# 3     1999_1 6.9570 19.3945   12.4375 12.58700
# 4     2000_1 6.1350 18.7600   12.6250 13.06914
# 5     2000_1 6.6420 19.2670   12.6250 13.06914
# 6     2000_1 6.7255 19.3505   12.6250 13.06914

Rextester demo

Answer 2

Вот решение data.table.Это похоже на @Parfait за исключением того, что я заранее добавляю идентификатор, чтобы я мог сжать его без необходимости повторного соединения с исходной таблицей data.table.

library(data.table)
A_dt[, ID := seq_len(.N), by = Year_month]

A_dt[B_dt
     , on = 'Year_month'
     , .(Year_month, ID, Res = X1 - Longitude, X1, Longitude, CHL)
     , allow.cartesian = T
     ][, .SD[which.min(Res), ] , by = .(Year_month, ID)]

   Year_month ID    Res      X1 Longitude      CHL
1:     1999_1  1 6.9570 19.3945   12.4375 12.58700
2:     1999_1  2 6.9415 19.3790   12.4375 12.58700
3:     1999_1  3 6.7698 19.2073   12.4375 12.58700
4:     2000_1  1 6.6420 19.2670   12.6250 13.06914
5:     2000_1  2 6.1350 18.7600   12.6250 13.06914
6:     2000_1  3 6.7255 19.3505   12.6250 13.06914

Вот базовое решение R, аналогичноеподход.

A$ID <- ave(seq_len(nrow(A)), A$Year_month, FUN = seq_along)

A2 <- merge(A, B, by = 'Year_month')
A2$Difference <- A2$X1 - A2$Longitude

A2$Min_Diff <- ave(A2$Difference, A2$Year_month, A2$ID, FUN = min)
A2[A2$Min_Diff == A2$Difference, c('Year_month', 'ID', 'Difference', 'X1', 'Longitude', 'CHL')]

Наконец, поскольку были некоторые проблемы с типами данных, вот несколько способов, которые я затем преобразовал:

A <- data.frame("X1"=c("19.3945","19.379", "19.2073", "19.267", "18.760", "19.3505"), 
                "Year_month" = c("1999_1", "1999_1", "1999_1", "2000_1", "2000_1", "2000_1"))

B <- data.frame( "Longitude"=c("12.3125", "12.375", "12.4375","12.5", "12.5625", "12.625"  ),
                 "Year_month"=c("1999_1", "1999_1", "1999_1", "2000_1", "2000_1", "2000_1"),
                 "CHL"=c( 12.70245, 12.63853, 12.58700, 12.61019, 12.75727, 13.06914))

#If the whole data.frame is a factor, we can just remake the data.frame
A <- data.frame(lapply(A, as.character), stringsAsFactors = F)
A$X1 <- as.numeric(A$X1)

#For the B data.frame, I didn't want to use the lapply trick because 'CHL' was already good.
B$Longitude <- as.numeric(as.character(B$Longitude))
B$Year_Month <- as.character(B$Year_month)

# Alternatively, you address the data types on making your data.frames

# Note, you can add "stringsAsFactors = F" to the data.frame call and we could have skipped a step.
A_dt <- data.table(X1 = as.numeric(c("19.3945","19.379", "19.2073", "19.267", "18.760", "19.3505"))
                   , Year_month = c("1999_1", "1999_1", "1999_1", "2000_1", "2000_1", "2000_1"))

B_dt <- data.table(Longitude= as.numeric(c("12.3125", "12.375", "12.4375","12.5", "12.5625", "12.625"))
                   , Year_month=c("1999_1", "1999_1", "1999_1", "2000_1", "2000_1", "2000_1")
                   , CHL=c( 12.70245, 12.63853, 12.58700, 12.61019, 12.75727, 13.06914))

Answer 3

Я использую пакет varhandle для простого преобразования фактора в реальный.

Вот код:

library(varhandle)

# The data
A <- data.frame("X1"=c("19.3945","19.379", "19.2073", "19.267", "18.760", "19.3505"), 
                "Year_month" = c("1999_1", "1999_1", "1999_1", "2000_1", "2000_1", "2000_1"))
sapply(A, class)
#        X1 Year_month 
#  "factor"   "factor"

B <- data.frame( "Longitude"=c("12.3125", "12.375", "12.4375","12.5", "12.5625", "12.625"  ),
                 "Year_month"=c("1999_1", "1999_1", "1999_1", "2000_1", "2000_1", "2000_1"),
                 "CHL"=c( 12.70245, 12.63853, 12.58700, 12.61019, 12.75727, 13.06914))
sapply(B, class)
#  Longitude Year_month        CHL 
#   "factor"   "factor"  "numeric"

# Convert factor to real
A$X1 = unfactor(A$X1)
B$Longitude = unfactor(B$Longitude)

# Function to apply
getCHL <- function(row){
  # Select matching row on "Year_month"
  sub_df <- B[B$Year_month == row["Year_month"], ]
  # Select indice
  ind <- which.min(as.double(row["X1"]) - sub_df$Longitude)
  return( sub_df$CHL[ind] )
}
# Apply the function
A["CHL"] <- apply(A, MARGIN = 1, getCHL)