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



我一直在处理以下数据(它只代表整个数据集的一部分(:

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]处的数字除以表示从出现在df[2, 2]处的列b中的包含NA的第一行开始到下一个NON缺失值df[4, 2](包括(的所有先前行的数量的数字来填充,即0.1/3=0.033。

然后,值df[5-8, 3]通过在df[8, 2]处的数字(列中的下一个NON缺失值(除以数字来填充。数字表示从在df[5, 2]处出现的列b中的NA(=在df[4, 2]处的上一个NON缺失值之后的第一个NA(开始到下一个非缺失值df[8, 2](包括(的所有先前行的总和,即0.1/4=0.025。

最后,df[9, 3]处的值等于df[9,2]处的值,因为在df[9,2]处的数字之前存在任何NON缺失值。

有人愿意帮我写代码吗?

提前谢谢。

iod的回答相当广泛,但我认为它可以做得更短。

我们只需要知道在哪些位置有非NAs,但它们的实际值是多少并不重要。然后我们可以使用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)]

下面是一个使用tidyverse加上rle:增强版本的解决方案

首先,让我们创建一个rle,它也计算NA(从这里开始(:

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

这将计数放置在每种类型的CCD_ 24的最后一个位置。然而,我们关心的是NA的字符串:

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

最新更新