帶條件的樣條插值R

Question

我有一個非常大的數據集，結構如下圖所示。

我一直在嘗試使用na.spline函數，以便

1）找出收益率缺失的“菲普斯”類別。

2）如果少於3個收益率/ NA（在此為1-3），則樣條函數應插入並填寫NA。

3）如果“ fips”的NA收益不超過3，則代碼應刪除整個“ fips”子集，在這種情況下應刪除fips 2。

到目前為止，我的代碼：

 finX <- dataset

 finxx <- transform(subset(finX, ave(na.spline(finX$Yield), fips, FUN=sum)<2))

 #or

 finxx <- transform(subset(finX, ave(is.na(finX$Yield), fips, FUN=sum)<2))

Year   fips   Max     Min   Rain  Yield
1980   1      24.7    0.0   71    37
1981   1      22.8    0.0   62    40
1982   1      22.6    0.0   47    37
1983   1      24.2    0.0   51    39
1984   1      23.8    0.0   61    47
1985   1      25.1    0.0   67    43
1980   2      24.8    0.0   72    34
1981   2      23.2    0.4   54    **NA**
1982   2      25.3    0.1   83    55
1983   2      23.0    0.0   68    **NA**
1984   2      22.4    0.7   70    **NA**
1985   2      24.6    0.0   47    31
1980   3      25.5    0.0   51    31
1981   3      25.5    0.0   51    31
1982   3      25.5    0.0   51    31
1983   3      25.5    0.0   51    **NA**
1984   3      25.5    0.0   51    31
...

當前，以上代碼要么沒有填寫最終產品中的所有NA，要么根本沒有結果。

任何指導都將非常有用，謝謝。

Answer 1

Yield需要從字符轉換為數字或NA 。 然后使用by通過fips值將finX划分為單獨的數據幀。 對於每個少於3個NA's數據幀，進行樣條插值。 大於等於3的返回為NULL 。 將返回的數據幀list合並為單個數據幀。 代碼如下所示：

  library(zoo)
# convert finX$Yield values from character to either numeric or NA
  finX$Yield <- sapply(finX$Yield, function(x) if(x =="**NA**") NA_real_ else as.numeric(x))

# use spline interpolation on fips sets with less than 3 NA's
   finxx <- by(finX, finX$fips, function(x) if(sum(is.na(x$Yield)) < 3) transform(x, Yield=na.spline(object=Yield, x=Year)) )    
#  combine results into a single data frame
  finxx <- do.call(rbind, finxx)

或者，在轉換為數值后，您可以在Yield列上使用ave ，其中樣條插值將返回具有少於3個NA的fips集和所有其他NA的所有NA的值。 最終結果中帶有任何NA的所有行將被刪除。 代碼如下：

finxx2 <- transform(finX, Yield=ave(Yield, fips, FUN=function(x) if(sum(is.na(x)) < 3) na.spline(object=x) else NA))
finxx2 <- na.omit(finxx2)

兩種版本都為樣本數據提供了相同的結果，但是使用by的第一個版本允許您為每個fips集使用完整的數據幀，而不僅僅是Yield 。 在這種情況下，可以為樣條插值中的x值指定Year ，因此任何缺少Year數據集仍將給出正確的插值。 ave版本將得到不正確的答案。 因此， by版本似乎更強大。

還有dplyr版本，與上面的by版本非常相似，並且給出的答案與基本R版本相同。 如果您可以使用dplyr ，那么這可能是最簡單，最可靠的方法。

library(dplyr)
finxx3 <- finX %>% group_by(fips) %>%
      filter(sum(is.na(Yield)) < 3) %>%
      mutate(Yield=na.spline(object=Yield, x=Year))

第一個版本返回

     Year fips  Max Min Rain Yield
1.1  1980    1 24.7   0   71    37
1.2  1981    1 22.8   0   62    40
1.3  1982    1 22.6   0   47    37
1.4  1983    1 24.2   0   51    39
1.5  1984    1 23.8   0   61    47
1.6  1985    1 25.1   0   67    43
3.13 1980    3 25.5   0   51    31
3.14 1981    3 25.5   0   51    31
3.15 1982    3 25.5   0   51    31
3.16 1983    3 25.5   0   51    31
3.17 1984    3 25.5   0   51    31