如何按类别

时间:2018-01-05 12:02:39

标签: r database

我们在夏季收集了超过130000个植物物候观测资料,并将数据输入Excel。每个观察包括1至6个分类变量,描述植物物候学的不同方面。例如,我可能会收集一棵白桦树的观察 - 生长的叶子,或者我可能收集两棵白桦树的观察结果 - 叶子长大和开花。

不幸的是,我通过不在数据表上按逻辑顺序收集分类代码来创建数据噩梦,因此在Excel中输入它们而不反映物候代码的类别(即其他,流出,开花,水果,叶子衰老,叶片脱落)

以下是我的数据的样子(在问题底部找到R的样本数据):

enter image description here

以下是我的数据:

enter image description here

我创建了一个包含所有物候代码及其相关物候类别的电子表格(同样,其他,流出,开花,水果,叶片衰老,叶子脱落)。

我想使用我已导入R的物候代码电子表格(请参阅底部的代码)将我的数据集重组为上面显示的逻辑格式。我可以通过创建每个新字段然后编写大量条件语句(不需要物候代码电子表格!)来做到这一点,但我不知道如何有效地使用我的数据和物候代码来快速有效地重新组织我的数据。

最后,在我的物候代码电子表格中,我创建了一个排名字段来处理这样一个事实:有时我的技术人员在同一类别中记录了两个观察结果。在这种情况下,应始终以最高数字或等级为准。

Sample.Data <- structure(list(Species = c("A", "B", "C", "D", "E","F", "G", "H", "I", 
               "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T"), 
               Code.1 = c("C", "C", "C", "C", "C", "C", "C", "C", "C", "C", 
               "C", "C", "C", "C", "C", "C", "C", "C", "C", "C"), 
               Code.2 = c("V", "0", "rf", "0", "0", "0", "uf", "uf", "uf", "uf", "0", "0", "0", 
               "0", "uf", "uf", "0", "0", "0", "0"), Code.3 = c("g3", "gd", "r3", "r3", "r3", "r3", 
               "V", "V", "V", "V", "g1", "gd", "vd", "g1", "V", "V", "g1", "r3", "r3", "r3"), 
               Code.4 = c("vd", "vd", "vd", "vd", "vd", "vd", "g3", "g3", "g3", "g3", "vd", "vd", "r2", 
               "vd", "g1", "vd", "vd", "vd", "vd", "vd"), 
               Code.5 = c("L2", "L1", "L1", "L2", "L2", "L2", "L2", "L2", "L3", "L2", "L3", "L2", "L2", 
               "L3", "L1", "L1", "L2", "L1", "L1", "L2"), 
               Code.6 = c("K", "K", "K", "K", "b1", "b3", "b2", "K", "K", "b4", "K", "K", "K", "b1", 
               "b3", "Y", "Z", "Y", "K", "b1")), .Names = c("Species", "Code.1", "Code.2", 
               "Code.3", "Code.4", "Code.5", "Code.6"), row.names = c(NA, -20L), class = "data.frame")

Pheno.Codes <- structure(list(`Pheno Code` = c("Y", "0", "Z", "A", "B1", "B2", 
               "C", "FA", "As", "Af", "R", "Rs", "Rf", "Ra", "K", "w", "m", "mw", 
               "wm", "st", "b", "b1", "b2", "b3", "b2", "b4", "uf", "rd", "rf", 
               "V", "VL", "Vb", "gd", "gb", "g1", "g2", "g3", "ed", "r", "r1", 
               "r2", "r3", "vd", "vt", "L", "L1", "L2", "L3", "L4", "X"), 
               `Pheno Category` = c("Other", "Other", "Leaf-out", "Leaf-out", 
               "Leaf-out", "Leaf-out", "Leaf-out", "Flowering", "Flowering", 
               "Flowering", "Flowering", "Flowering", "Flowering", "Flowering", 
               "Flowering", "Flowering", "Flowering", "Flowering", "Flowering", 
               "Flowering", "Flowering", "Flowering", "Flowering", "Flowering", 
               "Flowering", "Flowering", "Fruit", "Fruit", "Fruit", "Fruit", 
               "Fruit", "Fruit", "Leaf senescence", "Leaf senescence", 
               "Leaf senescence", "Leaf senescence", "Leaf senescence", 
               "Leaf senescence", "Leaf senescence", "Leaf senescence", 
               "Leaf senescence", "Leaf senescence", "Leaf senescence", 
               "Leaf senescence", "Leaf abscission", "Leaf abscission", 
               "Leaf abscission", "Leaf abscission", "Leaf abscission", 
               "Other"), Rank = c(0, 0.1, 0.5, 1, 1.1, 1.2, 1.3, 2, 2, 2.1, 2, 
               2, 2.1, 2.3, 2, 2.1, 2.1, 2.1, 2.1, 2.1, 2.1, 2.1, NA, 2.3, NA, 
               2.5, 3, 3.1, 3.2, 3.2, 3.2, 3.3, 4, 4, 4.1, 4.2, 4.3, 4.4, 4.4, 
               4.5, 4.6, 4.7, 4.8, 4.9, 5, 5, 5.1, 5.2, 5.3, 6)), .Names = c("Pheno Code", 
               "Pheno Category", "Rank"), class = "data.frame", row.names = c(NA, -50L), 
               class = "data.frame")

Sample.Data2 <- structure(list(Species = c("A", "B", "C", "D", "E","F", "G", "H", "I", 
               "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T"), 
               Code.1 = c("C", "C", "B1", "C", "", "C", "C", "C", "C", "C", 
               "C", "C", "C", "C", "C", "C", "C", "C", "C", "C"), 
               Code.2 = c("V", "0", "rf", "0", "0", "0", "uf", "uf", "uf", "uf", "0", "", "0", 
               "0", "uf", "uf", "0", "0", "0", "0"), Code.3 = c("g3", "gd", "r3", "r3", "r3", "r3", 
               "V", "V", "", "V", "g1", "gd", "vd", "g1", "V", "V", "g1", "r3", "r3", "r3"), 
               Code.4 = c("", "vd", "vd", "vd", "vd", "vd", "g3", "g3", "g3", "g3", "vd", "vd", "r2", 
               "qd", "g1", "vd", "vd", "vd", "vd", "vd"), 
               Code.5 = c("L2", "L1", "L1", "L7", "L2", "L2", "L2", "L2", "L3", "L2", "L3", "L2", "L2", 
               "L3", "L1", "L1", "L2", "L1", "L1", "L2"), 
               Code.6 = c("", "", "K", "K", "b1", "b6", "b2", "K", "K", "b4", "K", "K", "K", "b1", 
               "b3", "Y", "Z", "Y", "K", "b1")), .Names = c("Species", "Code.1", "Code.2", 
               "Code.3", "Code.4", "Code.5", "Code.6"), row.names = c(NA, -20L), class = "data.frame")

2 个答案:

答案 0 :(得分:3)

data.table的可能解决方案:

# load the 'data.table'-package
library(data.table)

# convert both dataframes to data.table's
setDT(Sample.Data)
setDT(Pheno.Codes)

# reshape 'Sample.Data' to long format
sample.long <- melt(Sample.Data, id = 'Species')

# join with 'Pheno.Codes'
# filter/select for each 'Species'/'pheno.cat' combo the row where the rank is equal to the max rank
# reshape the result into wide format again
sample.long[Pheno.Codes, on = c('value' = 'Pheno Code'), `:=` (pheno.cat = `Pheno Category`, rnk = Rank)
            ][, .SD[rnk == max(rnk)], by = .(Species, pheno.cat)
              ][, dcast(.SD, Species ~ pheno.cat, value.var = 'value', fill = '')]

给出:

    Species Flowering Fruit Leaf abscission Leaf senescence Leaf-out Other
 1:       A         K     V              L2              vd        C      
 2:       B         K                    L1              vd        C     0
 3:       C         K    rf              L1              vd        C      
 4:       D         K                    L2              vd        C     0
 5:       E        b1                    L2              vd        C     0
 6:       F        b3                    L2              vd        C     0
 7:       G               V              L2              g3        C      
 8:       H         K     V              L2              g3        C      
 9:       I         K     V              L3              g3        C      
10:       J        b4     V              L2              g3        C      
11:       K         K                    L3              vd        C     0
12:       L         K                    L2              vd        C     0
13:       M         K                    L2              vd        C     0
14:       N        b1                    L3              vd        C     0
15:       O        b3     V              L1              g1        C      
16:       P               V              L1              vd        C     Y
17:       Q                              L2              vd        C     0
18:       R                              L1              vd        C     0
19:       S         K                    L1              vd        C     0
20:       T        b1                    L2              vd        C     0

更新

根据评论中提到的规范,您可以将代码调整为:

setDT(Sample.Data2)
setDT(Pheno.Codes)

sample.long <- melt(Sample.Data2, id = 'Species')[value != '']

sample.long[Pheno.Codes, on = c('value' = 'Pheno Code'), `:=` (pheno.cat = `Pheno Category`, rnk = Rank)
            ][is.na(pheno.cat), `:=` (pheno.cat = 'ERROR', rnk = 0)
              ][, .SD[rnk == max(rnk)], by = .(Species, pheno.cat)
                ][, dcast(.SD, Species ~ pheno.cat, value.var = 'value', fill = '')]

答案 1 :(得分:1)

使用tidyverse方法,您可以运行以下代码:

library(tidyverse)

以长格式重塑Sample.Data

sample_long <- Sample.Data %>% 
    gather(key=code,value=value,c(Code.1:Code.6)) %>% 
    ungroup() %>% 
    select(-code)

然后您加入Pheno.Codes,按Rank和“Pheno类别”选择最大Species并重新塑造数据框:

sample_coded <- left_join(sample_long,Pheno.Codes,by=c("value"="Pheno Code")) %>%
    distinct() %>% 
    group_by(Species,`Pheno Category`) %>% 
    filter(Rank==max(Rank)) %>% 
    ungroup() %>% 
    select(-Rank) %>% 
    spread(key=`Pheno Category`,value=value,fill=NA)

这是输出:

# A tibble: 20 x 7
   Species Flowering Fruit `Leaf-out` `Leaf abscission` `Leaf senescence` Other
 * <chr>   <chr>     <chr> <chr>      <chr>             <chr>             <chr>
 1 A       K         V     C          L2                vd                NA   
 2 B       K         NA    C          L1                vd                0    
 3 C       K         rf    C          L1                vd                NA   
 4 D       K         NA    C          L2                vd                0    
 5 E       b1        NA    C          L2                vd                0    
 6 F       b3        NA    C          L2                vd                0    
 7 G       NA        V     C          L2                g3                NA   
 8 H       K         V     C          L2                g3                NA   
 9 I       K         V     C          L3                g3                NA   
10 J       b4        V     C          L2                g3                NA   
11 K       K         NA    C          L3                vd                0    
12 L       K         NA    C          L2                vd                0    
13 M       K         NA    C          L2                vd                0    
14 N       b1        NA    C          L3                vd                0    
15 O       b3        V     C          L1                g1                NA   
16 P       NA        V     C          L1                vd                Y    
17 Q       NA        NA    C          L2                vd                0    
18 R       NA        NA    C          L1                vd                0    
19 S       K         NA    C          L1                vd                0    
20 T       b1        NA    C          L2                vd                0 

您可以设置缺失数据的值,更改代码最后一行中fill参数的值。