R apply code to different factors or levels -

R apply code to different factors or levels -

below code generate info demonstrate problem.

con <- textconnection(' nu na vo 100 60 103 2 104 2 106 5 107 1 108 1 112 50 100 b 1 108 b 4 109 b 2 120 b 30 109 c 40 ') tt <- read.table(con, header = t) close(con) test <- as.data.frame(tt)

i've next code. assign value "sta" column subject specific status , add together difference in "nu" between , i+1 row "lag" column.

library(dplyr) # sort "na" column , arrange "nu" in descending order # in order apply code below. test2 <- tt %.% arrange(na, -nu) (i in 1:nrow(test2)) { if (i < nrow(test2)) { if (test2[i, ]$nu - 2 > test2[i+1, ]$nu) { test2[i, 4] <- "n" test2[i, 5] <- test2[i, ]$nu - test2[i+1, ]$nu } else if (test2[i, ]$nu - 2 <= test2[i+1, ]$nu) { test2[i, 4] <- "y" test2[i, 5] <- test2[i, ]$nu - test2[i+1, ]$nu } } else if (i == nrow(test2)) { test2[i, 4] <- "n" test2[i, 5] <- 0 } } names(test2)[names(test2) == "v4"] <- "sta" names(test2)[names(test2) == "v5"] <- "lag" test2

after running code, produces result below:

nu na vo sta lag 1 112 50 n 4 2 108 1 y 1 3 107 1 y 1 4 106 5 y 2 5 104 2 y 1 6 103 2 n 3 7 100 60 y -20 8 120 b 30 n 11 9 109 b 2 y 1 10 108 b 4 n 8 11 100 b 1 y -9 12 109 c 40 n 0

the values under "sta" column assigned not "lag" column. original intention apply code based on different values/levels in "na", "a", "b", "c". don't how apply code "a", "b", "c" separately , combine separate results 1 table. desired outcome should be:

nu na vo sta lag 1 112 50 n 4 2 108 1 y 1 3 107 1 y 1 4 106 5 y 2 5 104 2 y 1 6 103 2 n 3 7 100 60 y 0 << lastly row "a". "lag" should "0"; "sta" should "n". 8 120 b 30 n 11 9 109 b 2 y 1 10 108 b 4 n 8 11 100 b 1 y 0 << lastly row "b". "lag" should "0"; "sta" should "n". 12 109 c 40 n 0 << lastly row "c". "lag" should "0"; "sta" should "n". edited

not sure how apply code different factors / levels of "na": "a", "b" , "c". possible utilize split() or apply family of functions? see result , intent of code above, result should factor / level / element dependent (hope i'm using proper terminology) , impact values under both "sta" , "lag" columns. code not distinguish this. appreciate help provided. thanks

an inelegant solution!

for completeness, post herewith possible solution. code hard way. if help simplify it, much appreciated.

con <- textconnection(' nu na vo 100 60 103 2 104 2 106 5 107 1 108 1 112 50 100 b 1 108 b 4 109 b 2 120 b 30 109 c 40 ') tt <- read.table(con, header = t) close(con) require(dplyr); require(data.table) test2 <- tt %.% arrange(na, -nu) spl <- split(test2, test2$na) spl (i in 1:length(levels(test2$na))) { (j in 1:nrow(spl[[i]])) { if (j < nrow(spl[[i]])) { if (spl[[i]][j, ]$nu - 2 > spl[[i]][j+1, ]$nu) { spl[[i]][j, 4] <- "n" spl[[i]][j, 5] <- spl[[i]][j, ]$nu - spl[[i]][j+1, ]$nu } else if (spl[[i]][j, ]$nu - 2 <= spl[[i]][j+1, ]$nu) { spl[[i]][j, 4] <- "y" spl[[i]][j, 5] <- spl[[i]][j, ]$nu - spl[[i]][j+1, ]$nu } } else if (j == nrow(spl[[i]])) { spl[[i]][j, 4] <- "n" spl[[i]][j, 5] <- 0 } } } spl <- rbindlist(spl) setnames(spl, c("v4", "v5"), c("sta", "lag")) spl

ave rescue - if applied twice same comparisons long loop code.

first, calculate lag differences using diff each group, , set value lastly row in each grouping 0. utilize computed lag values determine "sta" column, forcing lastly row in each group's value assigned "n".

test2$lag <- with(test2, ave(nu, na, fun=function(x) -c(diff(x),0)) ) test2$sta <- with(test2, ave(lag, na, fun=function(x) { out <- ifelse(x > 2, "n", "y"); out[length(out)] <- "n"; out}))

same result requested:

test2[c(1:3,5,4)] # nu na vo sta lag #1 112 50 n 4 #2 108 1 y 1 #3 107 1 y 1 #4 106 5 y 2 #5 104 2 y 1 #6 103 2 n 3 #7 100 60 n 0 #8 120 b 30 n 11 #9 109 b 2 y 1 #10 108 b 4 n 8 #11 100 b 1 n 0 #12 109 c 40 n 0

r apply