我一直在处理以下数据(它只代表整个数据集的一部分(:
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的回答相当广泛,但我认为它可以做得更短。
我们只需要知道在哪些位置有非NA
s,但它们的实际值是多少并不重要。然后我们可以使用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