编辑：更正

Question

我一直在处理以下数据（仅代表整个数据集的一部分）：

a <- seq(ISOdatetime(2017,08,18,0,0,0), ISOdatetime(2017,08,18,0,8,0), "min")
b <- c(0.1, NA, NA, 0.1, NA, NA, NA, 0.1, 0.1)
df <- data.frame(a, b)
                    a   b
1 2017-08-18 00:00:00 0.1
2 2017-08-18 00:01:00  NA
3 2017-08-18 00:02:00  NA
4 2017-08-18 00:03:00 0.1
5 2017-08-18 00:04:00  NA
6 2017-08-18 00:05:00  NA
7 2017-08-18 00:06:00  NA
8 2017-08-18 00:07:00 0.1
9 2017-08-18 00:08:00 0.1

列b表示降雨高度[mm]的测量值。我需要得到以下结果：

                    a   b     c
1 2017-08-18 00:00:00 0.1 0.100
2 2017-08-18 00:01:00  NA 0.033
3 2017-08-18 00:02:00  NA 0.033
4 2017-08-18 00:03:00 0.1 0.033
5 2017-08-18 00:04:00  NA 0.025
6 2017-08-18 00:05:00  NA 0.025
7 2017-08-18 00:06:00  NA 0.025
8 2017-08-18 00:07:00 0.1 0.025
9 2017-08-18 00:08:00 0.1 0.100

列c表示经修改的列b，如下所示：

值df[2-4, 3]用df[4, 2]处的数字除以数字表示，该数字表示从列b中包含NA的第一行开始的所有先前行的数目，其中出现在下一个非缺失值df[2, 2]（包括）的df[4, 2]处，即0.1 / 3 = 0.033。

然后，值df[5-8, 3]用df[8, 2]（该列中的下一个非缺失值）上的数字除以数字表示，该数字代表从{{ NA列中的1}}，出现在b（=在df[5, 2]的前一个非缺失值之后的第一个NA）到下一个非缺失值{ {1}}（包括），即0.1 / 4 = 0.025。

最后，df[4, 2]处的值等于df[8, 2]处的值，因为df[9, 3]处的数字之前有任何不漏的值。

有人愿意帮助我编写代码吗？

谢谢。

Answer 1

这是使用tidyverse加上rle的增强版本的解决方案：

首先，让我们创建一个rle，它也计算NA（来自here）：

rlena<-function (x)
{
    if (!is.vector(x) && !is.list(x))
        stop("'x' must be an atomic vector")
    n <- length(x)
    if (n == 0L)
        return(structure(list(lengths = integer(), values = x),
            class = "rle"))

    #### BEGIN NEW SECTION PART 1 ####
    naRepFlag<-F
    if(any(is.na(x))){
        naRepFlag<-T
        IS_LOGIC<-ifelse(typeof(x)=="logical",TRUE,FALSE)

        if(typeof(x)=="logical"){
            x<-as.integer(x)
            naMaskVal<-2
        }else if(typeof(x)=="character"){
            naMaskVal<-paste(sample(c(letters,LETTERS,0:9),32,replace=T),collapse="")
        }else{
            naMaskVal<-max(0,abs(x[!is.infinite(x)]),na.rm=T)+1
        }

        x[which(is.na(x))]<-naMaskVal
    }
    #### END NEW SECTION PART 1 ####

    y <- x[-1L] != x[-n]
    i <- c(which(y), n)

    #### BEGIN NEW SECTION PART 2 ####
    if(naRepFlag)
        x[which(x==naMaskVal)]<-NA

    if(IS_LOGIC)
        x<-as.logical(x)
    #### END NEW SECTION PART 2 ####

    structure(list(lengths = diff(c(0L, i)), values = x[i]),
        class = "rle")
}

现在我们可以这样做：

counts<-rlena(df$b)

哪个给了我们这个方便的表：

Run Length Encoding
  lengths: int [1:5] 1 2 1 3 2
  values : num [1:5] 0.1 NA 0.1 NA 0.1

现在可以实际创建您的列了：

df$aux[cumsum(counts$lengths)]<-counts$lengths

这会将计数放在每种b的最后一个位置。不过，我们关心的是NA s的字符串：

                    a   b aux
1 2017-08-18 00:00:00 0.1   1
2 2017-08-18 00:01:00  NA  NA
3 2017-08-18 00:02:00  NA   2
4 2017-08-18 00:03:00 0.1   1
5 2017-08-18 00:04:00  NA  NA
6 2017-08-18 00:05:00  NA  NA
7 2017-08-18 00:06:00  NA   3
8 2017-08-18 00:07:00 0.1  NA
9 2017-08-18 00:08:00 0.1   2

现在剩下的就是创建c列：

require(dplyr)
require(tidyr)
df %>% 
  mutate(c=ifelse(!is.na(b) & is.na(lag(b)),b/(lag(aux)+1),b)) %>% 
  fill(c,.direction="up")

结果：

                    a   b aux          c
1 2017-08-18 00:00:00 0.1   1 0.03333333
2 2017-08-18 00:01:00  NA  NA 0.03333333
3 2017-08-18 00:02:00  NA   2 0.03333333
4 2017-08-18 00:03:00 0.1   1 0.03333333
5 2017-08-18 00:04:00  NA  NA 0.02500000
6 2017-08-18 00:05:00  NA  NA 0.02500000
7 2017-08-18 00:06:00  NA   3 0.02500000
8 2017-08-18 00:07:00 0.1  NA 0.02500000
9 2017-08-18 00:08:00 0.1   2 0.10000000

Answer 2

iod给出了广泛的答案，但我认为它可以做的短得多。

我们只需要知道非NA的位置是什么，但它们的实际值是多少并不重要。然后，我们可以使用diff来查看延伸的长度，并且可以计算每行的分子和分母。我的第一个代码：

 counts <- diff(c(which(!is.na(b)), length(b)+1))
 num <- unlist(Map(rep, b[!is.na(b)], counts))
 denom <- unlist(Map(rep, counts, counts))
 result <- c(b[1], num/denom)[1:length(b)]

编辑：更正

事实证明，我没有足够仔细地阅读您的问题，所以我的回答略有错误。原始代码向上看，第2至4行取决于b列第1行中的值。
但是您需要它向下看，所以我的更正代码如下：

counts <- diff(c(0, which(!is.na(b))))
num <- unlist(Map(rep, b[!is.na(b)], counts))
denom <- unlist(Map(rep, counts, counts))
result <- c(num/denom)[1:length(b)]

数据框修改-R中的降雨强度

2 个答案:

编辑：更正