R 按组排序,将总计分配给排名最高的项目,将0分配给其余项目

R 按组排序,将总计分配给排名最高的项目,将0分配给其余项目,r,gis,R,Gis,我的目标是在美国各县的基础地图上绘制大都市统计区(MSA或CBAS)及其人口。MSA县将被着色,非MSA县保留空白(基本choropleth地图)。澳门特别行政区总人口将以各澳门特别行政区人口最多的县为中心的比例圆圈表示。我正在处理基础数据,遇到了一个障碍 数据位于超过1000行的df中,其中此示例: head(pop_2010_map[order(pop_2010_map$cbsa_code),], 5) cbsa_code cbsa_name county_code_long Pop

我的目标是在美国各县的基础地图上绘制大都市统计区(MSA或CBAS)及其人口。MSA县将被着色,非MSA县保留空白(基本choropleth地图)。澳门特别行政区总人口将以各澳门特别行政区人口最多的县为中心的比例圆圈表示。我正在处理基础数据,遇到了一个障碍

数据位于超过1000行的df中,其中此示例:

head(pop_2010_map[order(pop_2010_map$cbsa_code),], 5)
    cbsa_code cbsa_name county_code_long Population
936     10180   Abilene            48059      13544
967     10180   Abilene            48253      20202
993     10180   Abilene            48441     131506
765     10420     Akron            39133     161419
768     10420     Akron            39153     541781
我需要按cbsa_代码汇总人口,并将总数分配给每个cbsa_代码中最大(最高人口)的县_代码_long,将0分配给剩余的县_代码_long

预期结果应如下所示:

    cbsa_code cbsa_name county_code_long Population
936     10180   Abilene            48059          0
967     10180   Abilene            48253          0
993     10180   Abilene            48441     165252
765     10420     Akron            39133          0
768     10420     Akron            39153     703200

谢谢你的帮助

您可以通过使用
dplyr
的函数
groupby()
mutate()
以及
ifelse
语句来实现这一点,如下所示:

# Load library
library(dplyr)

# Create example data.frame
x <- read.table(text = 
"cbsa_code cbsa_name county_code_long Population
936     10180   Abilene            48059      13544
967     10180   Abilene            48253      20202
993     10180   Abilene            48441     131506
765     10420     Akron            39133     161419
768     10420     Akron            39153     541781")

# Desired result
new_x <- x %>% 
  group_by(cbsa_code) %>% 
  mutate(Population = ifelse(Population == max(Population), 
                             sum(Population), 0)) %>% 
  ungroup()
。。。“阿克伦”郡有两个参赛者

导致:

# A tibble: 6 x 4
  cbsa_code cbsa_name county_code_long Population
      <int>    <fctr>            <int>      <dbl>
1     10180   Abilene            48059          0
2     10180   Abilene            48253          0
3     10180   Abilene            48441     165252
4     10420     Akron            39133          0
5     10420     Akron            39153    1244981
6     10420     Akron            39154          0
# A tibble: 2 x 4
  cbsa_code cbsa_name Population county_code_long
      <int>    <fctr>      <int>            <int>
1     10180   Abilene     165252            48059
2     10420     Akron    1244981            39133
导致:

# A tibble: 6 x 4
  cbsa_code cbsa_name county_code_long Population
      <int>    <fctr>            <int>      <dbl>
1     10180   Abilene            48059          0
2     10180   Abilene            48253          0
3     10180   Abilene            48441     165252
4     10420     Akron            39133          0
5     10420     Akron            39153    1244981
6     10420     Akron            39154          0
# A tibble: 2 x 4
  cbsa_code cbsa_name Population county_code_long
      <int>    <fctr>      <int>            <int>
1     10180   Abilene     165252            48059
2     10420     Akron    1244981            39133
#一个tible:2 x 4
哥伦比亚广播公司代码哥伦比亚广播公司名称人口县代码龙
10180阿比林165252 48059
2 10420阿克伦1244981 39133

谢谢!但是,我需要将组总人口分配给组中人口最多的项目。我相信您所做的只是将0分配给非顶级代码。我已经调整了你的代码,我认为这是可行的:
new\u x%groupby(cbsa\u code)%%>%mutate(Population=ifelse(Population==max(Population),sum(Population),0))%%>%ungroup()
@syre对不起,你完全正确!我已经更正了答案。另外,顺便说一句,如果你实际上不想让另一个
country\u code\u long
,你可以做
x%>%group\u by(cbsa\u code,cbsa\u name)%%>%summary(Population=sum(Population),country\u code\u long=max(country\u code\u long))%%>%ungroup()
根据
cbsa\u-code
,实际上每个
cbsa\u-code
会得到多个结果。我认为确保每个
cbsa\u code
只有一个结果的一种方法是在命令管道的末尾添加
distinct()
。我不想把
county\u code\u long
(这是一个id代码)排序,而是将
Population
排序,因此您的代码仍然有点偏离。看看我的解决方案。你说得对,我们应该避免打领带,所以请添加
distinct()
。如果我知道确切的位置,我会自己做的。@syre抱歉!我希望这次我做对了。。。我已经对其进行了修改,并对答案进行了扩展,以处理最大人口中可能存在的联系(
distinct()
的想法根本不起作用!)。我希望这是有意义的。谢谢,但这对我的大数据集不起作用。例如,一些组的结尾都是0,而其他组的结尾都是多个非0数字。实际上,我在写之前就警告过你了。。。我过分简化了它。。只是告诉你怎么做。也许我可以试着写一个通用格式的代码非常感谢你的好意,但是我已经在我对第一个答案的评论中找到了一个解决方案,所以不要在这个问题上浪费你太多的时间。
# Rank the Population values according to their descending order, so that the 
## one with maximum is ranked 1 (if there are ties, only one of them is chosen).
y %>% 
  group_by(cbsa_code) %>% 
  mutate(pop_rank = row_number(desc(Population)),
         Population = ifelse(pop_rank == 1, 
                             sum(Population), 0)) %>% 
  ungroup() %>% 
  select(-pop_rank)
# A tibble: 6 x 4
  cbsa_code cbsa_name county_code_long Population
      <int>    <fctr>            <int>      <dbl>
1     10180   Abilene            48059          0
2     10180   Abilene            48253          0
3     10180   Abilene            48441     165252
4     10420     Akron            39133          0
5     10420     Akron            39153    1244981
6     10420     Akron            39154          0
y %>% 
  group_by(cbsa_code, cbsa_name) %>% 
  summarise(Population = sum(Population), 
            county_code_long = county_code_long[1]) %>% 
  ungroup()
# A tibble: 2 x 4
  cbsa_code cbsa_name Population county_code_long
      <int>    <fctr>      <int>            <int>
1     10180   Abilene     165252            48059
2     10420     Akron    1244981            39133
 x <- read.table(text = 
              "cbsa_code cbsa_name county_code_long Population
            936     10180   Abilene            48059      13544
            967     10180   Abilene            48253      20202
            993     10180   Abilene            48441     131506
            765     10420     Akron            39133     161419
            768     10420     Akron            39153     541781")
   a=mapply(tapply,list(x$Population),list(x$cbsa_code),c(sum,which.max))
   x$Population=0;x$Population[cumsum(a[,2])]=a[,1]
   x
              cbsa_code cbsa_name county_code_long  Population
  936            10180    Abilene            48059          0
  967            10180    Abilene            48253          0
  993            10180    Abilene            48441     165252
  765            10420      Akron            39133          0
  768            10420      Akron            39153     703200