【问题标题】:R: apply function to subsets based on column valueR:根据列值将函数应用于子集
【发布时间】:2019-01-14 06:10:20
【问题描述】:

我有一个名为income.df 的数据框,看起来像这样:

ID region income
1 rot 3700
2 ams 2500
3 utr 3300
4 utr 5300
5 utr 4400
6 ams 3100
8 ams 3000
9 rot 4000
10 rot 4400
12 rot 2000

我想使用Gini 函数来计算每个区域的基尼系数。如果我想为整个数据帧计算它,而不考虑区域,我会执行以下操作:

library(DescTools)
Gini(income.df$income, n = rep(1, length(income.df$income)), unbiased = TRUE, conf.level = NA, R = 1000, type = "bca", na.rm = TRUE)

有没有办法为数据框中的每个区域执行此操作?那么在这种情况下“rot”、“utr”和“ams”呢?请注意,Gini 函数还需要其中向量的长度(三个区域分别为 4、3 和 3)。我怀疑像 lapply 这样的东西可以做到这一点,但我不知道如何在函数中自动传递这些长度(我的实际数据框要大得多,所以手动不是一个选项)。

【问题讨论】:

    标签: r subset gini


    【解决方案1】:

    使用基础 R:

    library(DescTools)
    lapply(split(df,df$region), 
           function(x) (Gini(x$income, n = rep(1, length(x$income)), unbiased = TRUE, 
                             conf.level = NA, R = 1000, type = "bca", na.rm = TRUE)))
    

    使用 tidyverse:

    library(tidyverse)
    library(DescTools)
    df %>% group_by(region) %>% nest() %>% 
           mutate(gini_coef = map(data, ~Gini(.x$income, n = rep(1, length(.x$income)), 
                  unbiased = TRUE, conf.level = NA, R = 1000, type = "bca", na.rm = TRUE))) %>%
           select(-data) %>% unnest() %>% left_join(df)
    
    
    Joining, by = "region"
    # A tibble: 10 x 4
    region   gini_coef ID  income
    <fct>    <dbl>   <int>  <int>
    1 rot    0.177      1   3700
    2 rot    0.177      9   4000
    3 rot    0.177     10   4400
    4 rot    0.177     12   2000
    5 ams    0.0698     2   2500
    6 ams    0.0698     6   3100
    7 ams    0.0698     8   3000
    8 utr    0.154      3   3300
    9 utr    0.154      4   5300
    10 utr    0.154      5   4400
    

    数据

     df <- read.table(text="  
                ID region income
                 1 rot 3700
                 2 ams 2500
                 3 utr 3300
                 4 utr 5300
                 5 utr 4400
                 6 ams 3100
                 8 ams 3000
                 9 rot 4000
                 10 rot 4400
                 12 rot 2000
                 ",header=T)
    

    【讨论】:

      猜你喜欢
      • 2014-08-05
      • 1970-01-01
      • 2016-03-08
      • 2020-02-17
      • 1970-01-01
      • 1970-01-01
      • 2019-03-27
      • 1970-01-01
      • 2013-11-19
      相关资源
      最近更新 更多