[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