-3

更新于 2012-09-24 06:52:00Z

大卫罗宾逊问了一些非常好的问题之后,我意识到我最初的问题并不准确。

我正在考虑我的问题是一个两步的事情,

首先,我需要查看我的数据以识别id只有 s 的 stime intake_arm_1并创建一个新行,其中只有他们的 # in idv_001_arm_1intime和他们的 # in c_nt_name为了在他们和我之间获得正确的匹配,c_name我使用了lookup这张桌子。

id其次,我需要在 'v_001_arm_1' 上执行或多或少相同的操作,但v_010_arm_1如果最新的armti_all注册,请按 计数这些实例ty_all,并将这些数字写入列out_cout_cintake_arm_1此外,如果最新ti_all的不是 NA ,我还必须将名称编号从该新行传输到该新行。

新的v_00n_arm_1的 #应该是“当前突出显示编号”(例如v_007_arm_1)+ 1(例如v_008_arm_1)。

我将致力于手动制作一个引人注目的示例来说明我的目标。

lookup <- structure(list(c_name = c(1L, 2L, 4L, 5L, 6L, 7L), t_name = structure(1:6, .Label = c("Bob", "Julian", "Mitt", "Ricky", "Tom", "Victor"), class = "factor")), .Names = c("c_name", "t_name"), class = "data.frame", row.names = c("1", "2", "3", "4", "5", "6"))
> lookup
  c_name t_name
1      1    Bob
2      2 Julian
3      4   Mitt
4      5  Ricky
5      6    Tom
6      7 Victor

mydata <- structure(list(id = c(1L, 1L, 2L, 3L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 5L, 5L, 6L, 7L, 7L, 7L, 7L, 8L, 9L), time = c("intake_arm_1", "v_001_arm_1", "intake_arm_1", "intake_arm_1", "intake_arm_1", "v_001_arm_1", "v_002_arm_1", "v_003_arm_1", "v_004_arm_1", "v_005_arm_1", "v_006_arm_1", "v_007_arm_1", "intake_arm_1", "v_001_arm_1", "intake_arm_1", "intake_arm_1", "v_011_arm_1", "v_012_arm_1", "v_013_arm_1", "intake_arm_1", "intake_arm_1"), dat_all = c(NA, NA, NA, NA, NA, NA, NA, "2012-09-23", "2012-09-23", "2012-09-02", "2012-09-10", "2012-09-23", NA, NA, NA, NA, "2012-09-23", "2012-09-23", "2012-09-23", NA, NA), ti_all = c(NA, NA, NA, NA, NA, NA, NA, 6L, 44L, 33L, NA, 22L, NA, NA, NA, NA, 65L, NA, 10L, NA, NA),     ty_all = c(NA, NA, NA, NA, NA, NA, NA, "out_", "out_", "cma_",     NA, "cma_", NA, NA, NA, NA, "out_", "out_", "out_", NA, NA), out_c = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,     NA, NA, NA, NA, NA, NA, NA, NA, NA, NA), cma_c = c(NA, NA,     NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,     NA, NA, NA, NA), c_n = c(NA, 1L, NA, NA, NA, NA, NA, 7L,     4L, 7L, NA, 1L, NA, 2L, NA, NA, 7L, 7L, 7L, NA, NA), t_name = c("Tom",     NA, "Ricky", "Ricky", "Victor", NA, NA, NA, NA, NA, NA, NA,     "Julian", NA, "Julian", "Bob", NA, NA, NA, "Mitt", "Mitt")), .Names = c("id", "time", "dat_all", "ti_all", "ty_all", "out_c", "cma_c", "c_n", "t_name"), class = "data.frame", row.names = c("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", "16", "17", "18", "19", "20", "21"))
> mydata    
     id          time    dat_all ti_all ty_all out_c cma_c  c_n  t_name
1     1  intake_arm_1         NA     NA     NA    NA    NA   NA     Tom
2     1   v_001_arm_1         NA     NA     NA    NA    NA    1      NA
3     2  intake_arm_1         NA     NA     NA    NA    NA   NA   Ricky
4     3  intake_arm_1         NA     NA     NA    NA    NA   NA   Ricky
5     4  intake_arm_1         NA     NA     NA    NA    NA   NA  Victor
6     4   v_001_arm_1         NA     NA     NA    NA    NA   NA      NA
7     4   v_002_arm_1         NA     NA     NA    NA    NA   NA      NA
8     4   v_003_arm_1 2012-09-23      6   out_    NA    NA    7      NA
9     4   v_004_arm_1 2012-09-23     44   out_    NA    NA    4      NA
10    4   v_005_arm_1 2012-09-02     33   cma_    NA    NA    7      NA
11    4   v_006_arm_1 2012-09-10     NA     NA    NA    NA   NA      NA
12    4   v_007_arm_1 2012-09-23     22   cma_    NA    NA    1      NA
13    5  intake_arm_1         NA     NA     NA    NA    NA   NA  Julian
14    5   v_001_arm_1         NA     NA     NA    NA    NA    2      NA
15    6  intake_arm_1         NA     NA     NA    NA    NA   NA  Julian
16    7  intake_arm_1         NA     NA     NA    NA    NA   NA     Bob
17    7   v_011_arm_1 2012-09-23     65   out_    NA    NA    7      NA
18    7   v_012_arm_1 2012-09-23     NA   out_    NA    NA    7      NA
19    7   v_013_arm_1 2012-09-23     10   out_    NA    NA    7      NA
20    8  intake_arm_1         NA     NA     NA    NA    NA   NA    Mitt
21    9  intake_arm_1         NA     NA     NA    NA    NA   NA    Mitt

这就是我的目标(除非我打错了),

    id          time    dat_all ti_all ty_all out_c cma_c  c_n  t_name
1    1  intake_arm_1         NA     NA     NA    NA    NA   NA     Tom
2    1   v_001_arm_1         NA     NA     NA    NA    NA    1      NA
3    2  intake_arm_1         NA     NA     NA    NA    NA   NA   Ricky
4    2   v_001_arm_1         NA     NA     NA    NA    NA    5      NA
5    3  intake_arm_1         NA     NA     NA    NA    NA   NA   Ricky
6    3   v_001_arm_1         NA     NA     NA    NA    NA    5      NA
7    4  intake_arm_1         NA     NA     NA    NA    NA   NA  Victor
7    4   v_001_arm_1         NA     NA     NA    NA    NA   NA      NA
8    4   v_002_arm_1         NA     NA     NA    NA    NA   NA      NA
9    4   v_003_arm_1 2012-09-23      6   out_     1    NA    7      NA
10   4   v_004_arm_1 2012-09-23     44   out_     2    NA    4      NA
11   4   v_005_arm_1 2012-09-02     33   cma_     2     1    7      NA
12   4   v_006_arm_1 2012-09-10     NA     NA     2     1   NA      NA
13   4   v_007_arm_1 2012-09-23     22   cma_     2     2    1      NA
14   4   v_008_arm_1         NA     NA     NA     2     2    7      NA
15   5  intake_arm_1         NA     NA     NA    NA    NA   NA  Julian
16   5   v_001_arm_1         NA     NA     NA    NA    NA    2      NA
17   6  intake_arm_1         NA     NA     NA    NA    NA   NA  Julian
18   6   v_001_arm_1         NA     NA     NA    NA    NA    2      NA
19   7  intake_arm_1         NA     NA     NA    NA    NA   NA     Bob
20   7   v_011_arm_1 2012-09-23     65   out_     1    NA    7      NA
21   7   v_012_arm_1 2012-09-23     NA   out_     1    NA    7      NA
22   7   v_013_arm_1 2012-09-23     10   out_     2    NA    7      NA
23   7   v_014_arm_1         NA     NA     NA     2    NA    1      NA
24   8  intake_arm_1         NA     NA     NA    NA    NA   NA    Mitt
25   8   v_001_arm_1         NA     NA     NA    NA    NA    4      NA
26   9  intake_arm_1         NA     NA     NA    NA    NA   NA    Mitt
27   9   v_001_arm_1         NA     NA     NA    NA    NA    4      NA

ps:我见过人们用aggregate和做惊人的事情tapply

4

1 回答 1

5

这是使用plyr的解决方案:

lookup <- structure(list(c_name = c(1L, 2L, 4L, 5L, 6L, 7L), t_name = structure(1:6, .Label = c("Bob", "Julian", "Mitt", "Ricky", "Tom", "Victor"), class = "factor")), .Names = c("c_name", "t_name"), class = "data.frame", row.names = c("1", "2", "3", "4", "5", "6"))

mydata <- structure(list(id = c(1L, 1L, 2L, 3L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 5L, 5L, 6L, 7L, 7L, 7L, 7L, 8L, 9L), time = c("intake_arm_1", "v_001_arm_1", "intake_arm_1", "intake_arm_1", "intake_arm_1", "v_001_arm_1", "v_002_arm_1", "v_003_arm_1", "v_004_arm_1", "v_005_arm_1", "v_006_arm_1", "v_007_arm_1", "intake_arm_1", "v_001_arm_1", "intake_arm_1", "intake_arm_1", "v_011_arm_1", "v_012_arm_1", "v_013_arm_1", "intake_arm_1", "intake_arm_1"), dat_all = c(NA, NA, NA, NA, NA, NA, NA, "2012-09-23", "2012-09-23", "2012-09-02", "2012-09-10", "2012-09-23", NA, NA, NA, NA, "2012-09-23", "2012-09-23", "2012-09-23", NA, NA), ti_all = c(NA, NA, NA, NA, NA, NA, NA, 6L, 44L, 33L, NA, 22L, NA, NA, NA, NA, 65L, NA, 10L, NA, NA),     ty_all = c(NA, NA, NA, NA, NA, NA, NA, "out_", "out_", "cma_",     NA, "cma_", NA, NA, NA, NA, "out_", "out_", "out_", NA, NA), out_c = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,     NA, NA, NA, NA, NA, NA, NA, NA, NA, NA), cma_c = c(NA, NA,     NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,     NA, NA, NA, NA), c_n = c(NA, 1L, NA, NA, NA, NA, NA, 7L,     4L, 7L, NA, 1L, NA, 2L, NA, NA, 7L, 7L, 7L, NA, NA), t_name = c("Tom",     NA, "Ricky", "Ricky", "Victor", NA, NA, NA, NA, NA, NA, NA,     "Julian", NA, "Julian", "Bob", NA, NA, NA, "Mitt", "Mitt")), .Names = c("id", "time", "dat_all", "ti_all", "ty_all", "out_c", "cma_c", "c_n", "t_name"), class = "data.frame", row.names = c("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", "16", "17", "18", "19", "20", "21"))

library(plyr)

newrows <- ddply(mydata, .(id), function(subdata) {
    subdata_ty = subdata[!is.na(subdata$ty_all), ]
    if (NROW(subdata) == 1) {
        r = subdata[1, ]
        c("v_001_arm_1", NA, NA, NA, NA, NA,
                    lookup$c_name[lookup$t_name == r$t_name], r$t_name)
    }
    else if (NROW(subdata_ty) > 0 & !is.na(subdata_ty[NROW(subdata_ty), ]$dat_all)) {
        numbers = sapply(strsplit(subdata$time, "_"), function(l)
            ifelse(l[1] != "intake", as.numeric(l[2]), 0))
        newname = paste(c("v", sprintf("%03d", max(numbers) + 1), "arm", "1"),
                            collapse="_")
        r1 = subdata[1, ]
        new_c_n = lookup$c_name[lookup$t_name == r1$t_name]

        new_out_c = sum(subdata$ty_all == "out_" & !is.na(subdata$ti_all))
        new_cma_c = sum(subdata$ty_all == "cma_" & !is.na(subdata$ti_all))

        # you want them to be NA instead of 0:
        new_out_c = ifelse(new_out_c == 0, NA, new_out_c)
        new_cma_c = ifelse(new_cma_c == 0, NA, new_cma_c)        

        return(c(newname, NA, NA, NA, new_out_c, new_cma_c, new_c_n, NA))
    }
})

# recombine and sort
colnames(newrows) = colnames(mydata)
newdata = rbind(mydata, newrows)
newdata = newdata[order(newdata$id), ]
于 2012-09-24T08:02:55.433 回答