# [R] Loop for taking sum of rows based on proximity to other non-NA rows

arun smartpink111 at yahoo.com
Sat Oct 19 06:31:51 CEST 2013

Hi,

Found a bug in the function when tested.  So, try this (added one more line):

#Modified function
fun1 <- function(dat,n) {
rl <- rle(is.na(dat[,"Count"]))
indx <- which(is.na(dat[,"Count"]))[rep(rl\$lengths[rl\$values],rl\$lengths[rl\$values])==n]
lst1 <- lapply(split(indx,((seq_along(indx)-1)%/%n)+1),function(x) {
x1 <- dat[c(min(x)-1L,x,max(x)+1L),]
x2 <- x1[!is.na(x1\$Count),]
datN <- data.frame(Position=max(x2\$Position),Count=sum(x2\$Count))
rowN <- row.names(x2)[x2\$Position %in% max(x2\$Position)]
row.names(datN) <- if(length(rowN)>1) rowN[1] else rowN
datN
})
names(lst1) <- NULL
lst1 <- lst1[!duplicated(sapply(lst1,row.names))] ######added
dat2 <- do.call(rbind,lst1)
indx2 <-  sort(unlist(lapply(split(indx,((seq_along(indx)-1)%/%n)+1),function(x) c(min(x)-1L,x,c(max(x)+1L))),use.names=FALSE))

dat1New <- dat[-indx2[!indx2 %in% row.names(dat2)],]
dat1New[match(row.names(dat2),row.names(dat1New)),] <- dat2
row.names(dat1New) <- 1:nrow(dat1New)
dat1New
}

#Another function
fun2 <- function(dat,n){
indx <- cumsum(c(1,abs(diff(is.na(dat[,"Count"])))))
indx1 <- indx[is.na(dat[,"Count"])]
names(indx1) <- which(is.na(dat[,"Count"]))
indx2 <- indx1[indx1 %in% names(table(indx1))[table(indx1)==n]]
lst1 <- tapply(seq_along(indx2),list(indx2),FUN=function(i) {
x1 <- indx2[i]
x2 <- as.numeric(names(x1))
x3 <- dat[c(min(x2)-1L,x2,max(x2)+1L),]
x4 <- subset(x3, !is.na(Count))
x5 <- data.frame(Position=max(x4\$Position),Count=sum(x4\$Count))
ind <- x4\$Position %in% max(x4\$Position)
row.names(x5) <- if(sum(ind)>1) row.names(x4)[ind][1] else row.names(x4)[ind]
x5
})
attr(lst1,"dimnames") <- NULL
dat2 <- do.call(rbind,lst1)
indx3 <- sort(unlist(tapply(seq_along(indx2),list(indx2),FUN=function(i) {x1 <- indx2[i]
x2 <- as.numeric(names(x1))
c(min(x2)-1L, x2, max(x2)+1L)}),use.names=FALSE))

dat\$id <- 1:nrow(dat)
dat2\$id <- as.numeric(row.names(dat2))
library(plyr)
res <- join(dat,dat2[,-1],by="id",type="left")
res1 <- res[!((row.names(res) %in% indx3) & is.na(res[,4])),]
res1[,2][!is.na(res1[,4])] <- res1[,4][!is.na(res1[,4])]
res2 <- res1[,1:2]
row.names(res2) <- 1:nrow(res2)
res2
}

identical(fun1(dat1,1),fun2(dat1,1))
#[1] TRUE
identical(fun1(fun1(dat1,1),2),fun2(fun2(dat1,1),2))
#[1] TRUE

identical(fun1(fun1(fun1(dat1,1),2),3),fun2(fun2(fun2(dat1,1),2),3))
#[1] TRUE

#Speed
set.seed(185)
datT <- data.frame(Position = sample(10:80,1e5,replace=TRUE),Count= sample(c(NA, 10:100),1e5, replace=TRUE))
system.time(res <- fun1(datT,1))
#  user  system elapsed
# 0.676   0.000   0.676
system.time(res2 <- fun2(datT,1))
#   user  system elapsed
#  1.240   0.000   1.237
identical(res,res2)
#[1] TRUE

A.K.

On Friday, October 18, 2013 4:19 PM, arun <smartpink111 at yahoo.com> wrote:
Hi,

May be this helps:

dat1 <- structure(list(Position = c(15L, 22L, 38L, 49L, 55L, 61L, 62L,
14L, 29L, 63L, 46L, 22L, 18L, 24L, 22L, 49L, 42L, 38L, 29L, 22L,
29L, 23L, 42L), Count = c(15L, NA, NA, 5L, NA, 17L, 18L, NA,
NA, NA, 8L, NA, 20L, NA, NA, 16L, 19L, NA, NA, NA, 13L, NA, 33L
)), .Names = c("Position", "Count"), class = "data.frame", row.names = c(NA,
-23L))

#There might be simple solutions.

fun1 <- function(dat,n) {
rl <- rle(is.na(dat[,"Count"]))
indx <- which(is.na(dat[,"Count"]))[rep(rl\$lengths[rl\$values],rl\$lengths[rl\$values])==n]
lst1 <- lapply(split(indx,((seq_along(indx)-1)%/%n)+1),function(x) {
x1 <- dat[c(min(x)-1L,x,max(x)+1L),]
x2 <- x1[!is.na(x1\$Count),]
datN <- data.frame(Position=max(x2\$Position),Count=sum(x2\$Count))
rowN <- row.names(x2)[x2\$Position %in% max(x2\$Position)]
row.names(datN) <- if(length(rowN)>1) rowN[1] else rowN
datN
})
names(lst1) <- NULL
dat2 <- do.call(rbind,lst1)
indx2 <-  sort(unlist(lapply(split(indx,((seq_along(indx)-1)%/%n)+1),function(x) c(min(x)-1L,x,c(max(x)+1L))),use.names=FALSE))

dat1New <- dat[-indx2[!indx2 %in% row.names(dat2)],]
dat1New[match(row.names(dat2),row.names(dat1New)),] <- dat2
row.names(dat1New) <- 1:nrow(dat1New)
dat1New
}

dat1N <- fun1(dat1,1)
dat1N
Position Count
1        15    15
2        22    NA
3        38    NA
4        61    22
5        62    18
6        14    NA
7        29    NA
8        63    NA
9        46    28
10       24    NA
11       22    NA
12       49    16
13       42    19
14       38    NA
15       29    NA
16       22    NA
17       42    46

dat2N <- fun1(dat1N,2)
dat2N
Position Count
1        61    37
2        62    18
3        14    NA
4        29    NA
5        63    NA
6        49    44
7        42    19
8        38    NA
9        29    NA
10       22    NA
11       42    46
dat3N <- fun1(dat2N,3)
dat3N
Position Count
1       61    37
2       62    62
3       42    65

A.K.

Hi all, I have a dataset with 2 important columns, "Position" and
"Count". There are a total of 34,532 rows, but only 457 non-NA values in the "Count" column (every cell in "Position" column has a value). I
need to write a loop to march down the rows, and if there are 2 rows in
"Count" where there is only 1 NA row between them, sum the two values up and print only one row with the summed Count value and the Position
value that corresponds to the larger Count value, thus making the three
rows into one. For example:

Position Count
15 15
22 NA
38 NA
49 5
55 NA
61 17

would become

Position Count
15 15
22 NA
38 NA
61 22

After this step, I also need to write another script to march
down the rows and look for rows with only two NA's between non-NA rows
in Count. This would make the previous data become

Position Count
61 37

Ideally I would like a loop that can be flexibly adjusted to the
number of NA's in between adjacent non-NA values that can be freely
changed. I would greatly appreciate any insight for this.

More information about the R-help mailing list