Column with mean of 7 subsequent rows in R [duplicate] - r

This question already has answers here:
Calculating moving average
(17 answers)
Closed 2 years ago.
I got this df:
df <- data.frame(flow = c(1,2,3,4,5,6,7,8,9,10,11))
flow
1 1
2 2
3 3
4 4
5 5
6 6
7 7
8 8
9 9
10 10
11 11
and i want to get the week average from the line we're, like this:
flow flow7mean
1 1 4 `(mean of 1,2,3,4,5,6,7)`
2 2 5 (mean of 2,3,4,5,6,7,8)
3 3 6 (mean of 3,4,5,6,7,8,9)
4 4 7 (mean of 4,5,6,7,8,9,10)
5 5 8 (mean of 5,6,7,8,9,10,11)
6 6 NA (it's ok, because there is just 6 flow data)
7 7 NA
8 8 NA
9 9 NA
10 10 NA
11 11 NA
i have tried some loop solutions, but i think that a vectorized solution is better

Try this using rollmean() from zoo package:
library(zoo)
#Code
df$M <- rollmean(df$flow,k = 7,align = 'left',fill=NA)
Output:
df
flow M
1 1 4
2 2 5
3 3 6
4 4 7
5 5 8
6 6 NA
7 7 NA
8 8 NA
9 9 NA
10 10 NA
11 11 NA

We can use roll_mean from RcppRoll
library(RcppRoll)
df$flow7mean <- roll_mean(df$flow, 7, fill = NA, align = 'left')
-output
df
# flow flow7mean
#1 1 4
#2 2 5
#3 3 6
#4 4 7
#5 5 8
#6 6 NA
#7 7 NA
#8 8 NA
#9 9 NA
#10 10 NA
#11 11 NA

Here is a base R option using embed
within(df,flow7mean <- `length<-`(rowMeans(embed(flow,7)),length(flow)))
which gives
flow flow7mean
1 1 4
2 2 5
3 3 6
4 4 7
5 5 8
6 6 NA
7 7 NA
8 8 NA
9 9 NA
10 10 NA
11 11 NA

Related

How can I make some row values NA if other is NA in R?

I have a dataframe with three columns Time, observed value (Obs.Value), and an interpolated value (Interp.Value). If the value of Obs.Value is NA then the value of Interp.Value should also be NA. I can make the whole row NA but I need to keep the Time value.
Here is the repex:
dat <- data.frame(matrix(ncol = 3, nrow = 10))
x <- c("Time", "Obs.Value", "Interp.Value")
colnames(dat) <- x
dat$Time <- seq(1,10,1)
dat$Obs.Value <- c(5,6,7,NA,NA,5,4,3,NA,2)
interp <- approx(dat$Time,dat$Obs.Value,dat$Time)
dat$Interp.Value <- round(interp$y,1)
Here is the code that makes the whole row NA
dat[with(dat, is.na(Obs.Value)|is.na("Interp.Value")),] <- NA
Here is what the output should look like:
Time Obs.Value Interp.Value
1 1 5 5
2 2 6 6
3 3 7 7
4 4 NA NA
5 5 NA NA
6 6 5 5
7 7 4 4
8 8 3 3
9 9 NA NA
10 10 2 2
dat$Interp.Value[is.na(dat$Obs.Value)] <- NA
dat
# Time Obs.Value Interp.Value
# 1 1 5 5
# 2 2 6 6
# 3 3 7 7
# 4 4 NA NA
# 5 5 NA NA
# 6 6 5 5
# 7 7 4 4
# 8 8 3 3
# 9 9 NA NA
# 10 10 2 2
Or if either column being NA is sufficient, then
dat[!complete.cases(dat[,-1]),-1] <- NA
If there is only one column to change #r2evans' answer is pretty straightforward and way to go. If there are more than one column that you want to change you can use across in dplyr.
library(dplyr)
dat %>%
mutate(across(-c(Time,Obs.Value), ~replace(., is.na(Obs.Value), NA)))
# Time Obs.Value Interp.Value
#1 1 5 5
#2 2 6 6
#3 3 7 7
#4 4 NA NA
#5 5 NA NA
#6 6 5 5
#7 7 4 4
#8 8 3 3
#9 9 NA NA
#10 10 2 2

Is there any way to replace a missing value based on another columns' value to match the column name

I have a dataset:
a day day.1.time day.2.time day.3.time day.4.time day.5.time
1 NA 2 4 5 7 10 4
2 NA 5 4 1 1 6 NA
3 NA 3 7 9 6 7 4
4 NA 3 6 8 8 4 5
5 NA 3 5 2 4 5 6
6 NA 3 87 3 2 1 78
7 NA 1 NA 7 5 9 54
8 NA 5 6 6 3 2 3
9 NA 2 5 10 9 8 3
10 NA 3 9 4 10 3 3
I am trying to use the day column value to match with the day.x.time column to replace the missing value in column a. For instance, in the first row, the first value in the day column is 2, then we should use day.2.time value 5 to replace the first value in column a.
If the day.x.time value is missing, we should use -1 day or +1 day to replace the missing in column a. For instance, in the second row, the day column shows 5, so we should use the value in day.5.time column, but it's also a missing value. In this case, we should use the value in day.4.time column to replace the missing value in column a.
You can use dat = data.frame(a = rep(NA,10), day = c(2,5,3,3,3,3,1,5,2,3), day.1.time = c(4,4,7,6,5,87,NA,6,5,9), day.2.time = sample(10), day.3.time = sample(10), day.4.time = sample(10), day.5.time = c(4,NA,4,5,6,78,54,3,3,3)) to generate the sample data.
I have tried grep(paste0("^day."dat$day,".time$", names(dat)) to match with the column but my code isn't matching in every row, so any help would be appreciated!
Here is one way to do this.
The first part is easy to match day column with the corresponding day.x.time column. We can do this using matrix subsetting.
cols <- grep('day\\.\\d+\\.time', names(dat))
dat$a <- dat[cols][cbind(1:nrow(dat), dat$day)]
dat
# a day day.1.time day.2.time day.3.time day.4.time day.5.time
#1 3 2 4 3 3 3 4
#2 NA 5 4 4 10 2 NA
#3 1 3 7 8 1 8 4
#4 4 3 6 6 4 5 5
#5 6 3 5 10 6 7 6
#6 8 3 87 5 8 9 78
#7 NA 1 NA 1 7 10 54
#8 3 5 6 7 9 1 3
#9 2 2 5 2 5 6 3
#10 2 3 9 9 2 4 3
To fill values where day.x.time column is NA we can select the closest non-NA value in that row.
inds <- which(is.na(dat$a))
dat$a[inds] <- mapply(function(x, y)
na.omit(unlist(dat[x, cols[order(abs(y- seq_along(cols)))]])[1:4])[1],
inds, dat$day[inds])
dat
# a day day.1.time day.2.time day.3.time day.4.time day.5.time
#1 3 2 4 3 3 3 4
#2 2 5 4 4 10 2 NA
#3 1 3 7 8 1 8 4
#4 4 3 6 6 4 5 5
#5 6 3 5 10 6 7 6
#6 8 3 87 5 8 9 78
#7 1 1 NA 1 7 10 54
#8 3 5 6 7 9 1 3
#9 2 2 5 2 5 6 3
#10 2 3 9 9 2 4 3
Using sapply to loop over the rows and subset by day[i] + 2 column.
res <- transform(dat, a=sapply(1:nrow(dat), function(i) dat[i, dat$day[i] + 2]))
res
# a day day.1.time day.2.time day.3.time day.4.time day.5.time
# 1 5 2 4 5 7 10 4
# 2 NA 5 4 1 1 6 NA
# 3 6 3 7 9 6 7 4
# 4 8 3 6 8 8 4 5
# 5 4 3 5 2 4 5 6
# 6 2 3 87 3 2 1 78
# 7 NA 1 NA 7 5 9 54
# 8 3 5 6 6 3 2 3
# 9 10 2 5 10 9 8 3
# 10 10 3 9 4 10 3 3
Edit
The +/-2 days would require a decision rule, what to chose, if day is NA, but none of day - 1 and day + 1 is NA and both have the same values.
Here a solution that goes from day backwards and takes the first non-NA. If it is day one, as it's the case in row 7, we get NA.
res <- transform(dat, a=sapply(1:nrow(dat), function(i) {
days <- dat[i, -(1:2)]
day.value <- days[dat$day[i]]
if (is.na(day.value)) {
day.value <- tail(na.omit(unlist(days[1:dat$day[i]])), 1)
if (length(day.value) == 0) day.value <- NA
}
return(day.value)
}))
res
# a day day.1.time day.2.time day.3.time day.4.time day.5.time
# 1 10 2 4 10 1 2 4
# 2 10 5 4 1 3 10 NA
# 3 2 3 7 7 2 7 4
# 4 6 3 6 2 6 6 5
# 5 10 3 5 9 10 5 6
# 6 8 3 87 6 8 4 78
# 7 NA 1 NA 3 7 1 54
# 8 3 5 6 4 4 9 3
# 9 8 2 5 8 5 8 3
# 10 9 3 9 5 9 3 3

R remove first row of data frame until first row has no NA

I am applying na.approx on a data frame, which will not work if an NA happens to be in the very first or very last row of my data base.
How do I write a function doing the following:
"While any value of the first row of the data frame is NA, remove the first row"
Example data frame:
x1=x2=c(1,2,3,4,5,6,7,8,9,10,11,12)
x3=x4=c(NA,NA,3,4,5,6,NA,NA,NA,NA,11,12)
df=data.frame(x1,x2,x3,x4)
result for this example data frame should look like this:
result=df[-1:-2,]
My current attempts all look similar to this:
replace_na=function(df){
while(anyNA(df[1,])=TRUE){
df=df[-1,],
return(df)
}
#this is where I would apply the na.approx function to the data frame
}
Any help would be greatly appreciated, thanks!
You can use the complete.cases. With the cumsum, first incomplete rows will be deleted:
df[cumsum(complete.cases(df)) != 0, ]
x1 x2 x3 x4
3 3 3 3 3
4 4 4 4 4
5 5 5 5 5
6 6 6 6 6
7 7 7 NA NA
8 8 8 NA NA
9 9 9 NA NA
10 10 10 NA NA
11 11 11 11 11
12 12 12 12 12
#Psidom's answer is great, but you can also fix your own custom function:
replace_na=function(df){
while(anyNA(df[1,])==TRUE){
df=df[-1,]
}
#this is where I would apply the na.approx function to the data frame
return(df)
}
On its second line, == is the equal sign you need to use. On the second line, comma was superfluous. And last, return() needed to be moved out of the while loop.
replace_na(df)
# x1 x2 x3 x4
# 3 3 3 3 3
# 4 4 4 4 4
# 5 5 5 5 5
# 6 6 6 6 6
# 7 7 7 NA NA
# 8 8 8 NA NA
# 9 9 9 NA NA
# 10 10 10 NA NA
# 11 11 11 11 11
# 12 12 12 12 12
We can also use which.max and is.na
df[which.max(!rowSums(is.na(df))):nrow(df),]
# x1 x2 x3 x4
#3 3 3 3 3
#4 4 4 4 4
#5 5 5 5 5
#6 6 6 6 6
#7 7 7 NA NA
#8 8 8 NA NA
#9 9 9 NA NA
#10 10 10 NA NA
#11 11 11 11 11
#12 12 12 12 12

Removing rows from each dataframe in list with condition in R

I have such a list:
df1 <- data.frame(a=c(NA, NA, 1:10), b=c(NA, 1:11))
df2 <- data.frame(a=1:10, b=c(NA,1:9))
mylist <- list(df1, df2)
> mylist
[[1]]
a b
1 NA NA
2 NA 1
3 1 2
4 2 3
5 3 4
6 4 5
7 5 6
8 6 7
9 7 8
10 8 9
11 9 10
12 10 11
[[2]]
a b
1 1 NA
2 2 1
3 3 2
4 4 3
5 5 4
6 6 5
7 7 6
8 8 7
9 9 8
10 10 9
I'd like to remove all rows with more than 1 NA in a row in each data frame. How can I do that?
I found out how to delete rows
lapply(mylist, `[`, -1,)
and how to calculate the sum of NAs
NAsums <- function(x) {rowSums(is.na(x))}
lapply(mylist, NAsums)
But I can't figure out how to combine the two steps..
We loop through the list (lapply), use rowSums to get the number of NA elements in each row, convert to a logical vector (<2), and use that to subset the rows.
lapply(mylist, function(x) x[rowSums(is.na(x))<2,])
#[[1]]
# a b
#2 NA 1
#3 1 2
#4 2 3
#5 3 4
#6 4 5
#7 5 6
#8 6 7
#9 7 8
#10 8 9
#11 9 10
#12 10 11
#[[2]]
# a b
#1 1 NA
#2 2 1
#3 3 2
#4 4 3
#5 5 4
#6 6 5
#7 7 6
#8 8 7
#9 9 8
#10 10 9

R, Using reshape to pull pre post data

I have a simple data frame as follows
x = data.frame(id = seq(1,10),val = seq(1,10))
x
id val
1 1
2 2
3 3
4 4
5 5
6 6
7 7
8 8
9 9
10 10
I want to add 4 more columns. The first 2 are the previous two rows and the next two are the next two rows. For the first two rows and last two rows it needs to write out as NA.
How do I accomplish this using cast in the reshape package?
The final output would look like
1 1 NA NA 2 3
2 2 NA 1 3 4
3 3 1 2 4 5
4 4 2 3 5 6
... and so on...
Thanks much in advance
After your give the example , I change the solution
mat <- cbind(dat,
c(c(NA,NA),head(dat$id,-2)),
c(c(NA),head(dat$val,-1)),
c(tail(dat$id,-1),c(NA)),
c(tail(dat$val,-2),c(NA,NA)))
colnames(mat) <- c('id','val','idp','valp','idn','valn')
id val idp valp idn valn
1 1 1 NA NA 2 3
2 2 2 NA 1 3 4
3 3 3 1 2 4 5
4 4 4 2 3 5 6
5 5 5 3 4 6 7
6 6 6 4 5 7 8
7 7 7 5 6 8 9
8 8 8 6 7 9 10
9 9 9 7 8 10 NA
10 10 10 8 9 NA NA
Here is a soluting with sapply. First, choose the relative change for the new columns:
lags <- c(-2, -1, 1, 2)
Create the new columns:
newcols <- sapply(lags,
function(l) {
tmp <- seq.int(nrow(x)) + l;
x[replace(tmp, tmp < 1 | tmp > nrow(x), NA), "val"]})
Bind together:
cbind(x, newcols)
The result:
id val 1 2 3 4
1 1 1 NA NA 2 3
2 2 2 NA 1 3 4
3 3 3 1 2 4 5
4 4 4 2 3 5 6
5 5 5 3 4 6 7
6 6 6 4 5 7 8
7 7 7 5 6 8 9
8 8 8 6 7 9 10
9 9 9 7 8 10 NA
10 10 10 8 9 NA NA

Resources