使用 purrr 以编程方式创建新变量？
Programmatically create new variables using purrr?
简介
最近学习了 Hadley Wickham 的 functional programming class 之后，我决定尝试将其中的一些课程应用到我的工作项目中。当然，事实证明我尝试的第一个项目比 class 中演示的示例更复杂。有没有人建议使用 purrr 包来提高下面描述的任务的效率？
项目背景
我需要将五分位数组分配给空间多边形数据框中的记录。除了记录标识符之外，还有其他几个变量，我需要为每个变量计算五分位组。
这是问题的症结所在：有人要求我识别一个特定变量中的异常值，并从整个分析中忽略这些记录 只要它不改变变量的五分位数组成任何其他变量的第一个五分位数组.
问题
我已经建立了一个 dplyr 管道（参见下面的示例）来对单个变量执行此检查过程，但是我如何重写此过程以便我可以有效地检查每个变量？
编辑： 虽然作为中间步骤当然可以将数据的形状从宽更改为长，但最后它需要 return 到它的宽格式，使其与空间多边形数据帧的 @polygons 插槽相匹配。
可重现的例子
您可以在这里找到完整的脚本：https://gist.github.com/tiernanmartin/6cd3e2946a77b7c9daecb51aa11e0c94
库和设置
library(grDevices) # boxplot.stats()
library(operator.tools) # %!in% logical operator
library(tmap) # 'metro' data set
library(magrittr) # piping
library(dplyr) # exploratory data analysis verbs
library(purrr) # recursive mapping of functions
library(tibble) # improved version of a data.frame
library(ggplot2) # dot plot
library(ggrepel) # avoid label overlap
options(scipen=999)
set.seed(888)
加载示例数据并取一小部分样本
data("metro")
m_spdf <- metro
# Take a sample
m <-
metro@data %>%
as_tibble %>%
select(-name_long,-iso_a3) %>%
sample_n(50)
> m
# A tibble: 50 x 10
name pop1950 pop1960 pop1970 pop1980 pop1990
<chr> <dbl> <dbl> <dbl> <dbl> <dbl>
1 Sydney 1689935 2134673 2892477 3252111 3631940
2 Havana 1141959 1435511 1779491 1913377 2108381
3 Campinas 151977 293174 540430 1108903 1693359
4 Kano 123073 229203 541992 1349646 2095384
5 Omsk 444326 608363 829860 1032150 1143813
6 Ouagadougou 33035 59126 115374 265200 537441
7 Marseille 755805 928768 1182048 1372495 1418279
8 Taiyuan 196510 349535 621625 1105695 1636599
9 La Paz 319247 437687 600016 809218 1061850
10 Baltimore 1167656 1422067 1554538 1748983 1848834
# ... with 40 more rows, and 4 more variables:
# pop2000 <dbl>, pop2010 <dbl>, pop2020 <dbl>,
# pop2030 <dbl>
计算有和没有离群值记录的五分位数组
# Calculate the quintile groups for one variable (e.g., `pop1990`)
m_all <-
m %>%
mutate(qnt_1990_all = dplyr::ntile(pop1990,5))
# Find the outliers for a different variable (e.g., 'pop1950')
# and subset the df to exlcude these outlier records
m_out <- boxplot.stats(m$pop1950) %>% .[["out"]]
m_trim <-
m %>%
filter(pop1950 %!in% m_out) %>%
mutate(qnt_1990_trim = dplyr::ntile(pop1990,5))
# Assess whether the outlier trimming impacted the first quintile group
m_comp <-
m_trim %>%
select(name,dplyr::contains("qnt")) %>%
left_join(m_all,.,"name") %>%
select(name,dplyr::contains("qnt"),everything()) %>%
mutate(qnt_1990_chng_lgl = !is.na(qnt_1990_trim) & qnt_1990_trim != qnt_1990_all,
qnt_1990_chng_dir = if_else(qnt_1990_chng_lgl,
paste0(qnt_1990_all," to ",qnt_1990_trim),
"No change"))
在 ggplot2 的一点帮助下，我可以看到在这个例子中，六个异常值被识别出来，并且它们的遗漏不会影响 pop1990 的第一个五分位数组。
重要的是，此信息在两个新变量中进行跟踪：qnt_1990_chng_lgl 和 qnt_1990_chng_dir。
> m_comp %>% select(name,qnt_1990_chng_lgl,qnt_1990_chng_dir,everything())
# A tibble: 50 x 14
name qnt_1990_chng_lgl qnt_1990_chng_dir qnt_1990_all qnt_1990_trim
<chr> <lgl> <chr> <dbl> <dbl>
1 Sydney FALSE No change 5 NA
2 Havana TRUE 4 to 5 4 5
3 Campinas TRUE 3 to 4 3 4
4 Kano FALSE No change 4 4
5 Omsk FALSE No change 3 3
6 Ouagadougou FALSE No change 1 1
7 Marseille FALSE No change 3 3
8 Taiyuan TRUE 3 to 4 3 4
9 La Paz FALSE No change 2 2
10 Baltimore FALSE No change 4 4
# ... with 40 more rows, and 9 more variables: pop1950 <dbl>, pop1960 <dbl>,
# pop1970 <dbl>, pop1980 <dbl>, pop1990 <dbl>, pop2000 <dbl>, pop2010 <dbl>,
# pop2020 <dbl>, pop2030 <dbl>
我现在需要找到一种方法来为数据帧中的每个变量（即 pop1960 - pop2030）重复这个过程。理想情况下，将为每个现有 pop* 变量创建两个新变量，并且它们的名称将以 qnt_ 开头，然后是 _chng_dir 或 _chng_lgl.
purrr 是用于此的正确工具吗？ dplyr::mutate_？ data.table?
在我看来，您的分析没有任何问题，
这部分之后
m <- metro@data %>%
as_tibble %>%
select(-name_long,-iso_a3) %>%
sample_n(50)
只需融化您的数据并继续您的分析，但 group_by(year)
library(reshape2)
library(stringr)
mm <- melt(m)
mm[,2] <- as.factor(str_sub(mm[,2],-4))
names(mm)[2:3] <- c("year", "population")
例如，
mm %>% group_by(year) %>%
+ mutate(qnt_all = dplyr::ntile(population,5))
事实证明这个问题 是 可以使用 tidyr::gather + dplyr::group_by + tidyr::spread 函数解决。虽然 @shayaa 和 @Gregor 没有提供我正在寻找的解决方案，但他们的建议帮助我纠正了我正在研究的函数式编程方法。
我最终使用@shayaa 的 gather 和 group_by 组合，然后使用 mutate 创建变量名称（qnt_*_chng_lgl 和 qnt_*_chng_dir）和然后使用 spread 再次变宽。传递给 summarize_all 的匿名函数删除了 wide-long-wide 转换创建的所有额外 NA。
m_comp <-
m %>%
mutate(qnt = dplyr::ntile(pop1950,5)) %>%
filter(pop1950 %!in% m_out) %>%
gather(year,pop,-name,-qnt) %>%
group_by(year) %>%
mutate(qntTrim = dplyr::ntile(pop,5),
qnt_chng_lgl = !is.na(qnt) & qnt != qntTrim,
qnt_chng_dir = ifelse(qnt_chng_lgl,
paste0(qnt," to ",qntTrim),
"No change"),
year_lgl = paste0("qnt_chng_",year,"_lgl"),
year_dir = paste0("qnt_chng_",year,"_dir")) %>%
spread(year_lgl,qnt_chng_lgl) %>%
spread(year_dir,qnt_chng_dir) %>%
spread(year,pop) %>%
select(-qnt,-qntTrim) %>%
group_by(name) %>%
summarize_all(function(.){subset(.,!is.na(.)) %>% first})
简介
最近学习了 Hadley Wickham 的 functional programming class 之后，我决定尝试将其中的一些课程应用到我的工作项目中。当然，事实证明我尝试的第一个项目比 class 中演示的示例更复杂。有没有人建议使用 purrr 包来提高下面描述的任务的效率？
项目背景
我需要将五分位数组分配给空间多边形数据框中的记录。除了记录标识符之外，还有其他几个变量，我需要为每个变量计算五分位组。
这是问题的症结所在：有人要求我识别一个特定变量中的异常值，并从整个分析中忽略这些记录 只要它不改变变量的五分位数组成任何其他变量的第一个五分位数组.
问题
我已经建立了一个 dplyr 管道（参见下面的示例）来对单个变量执行此检查过程，但是我如何重写此过程以便我可以有效地检查每个变量？
编辑： 虽然作为中间步骤当然可以将数据的形状从宽更改为长，但最后它需要 return 到它的宽格式，使其与空间多边形数据帧的 @polygons 插槽相匹配。
可重现的例子
您可以在这里找到完整的脚本：https://gist.github.com/tiernanmartin/6cd3e2946a77b7c9daecb51aa11e0c94
库和设置
library(grDevices) # boxplot.stats()
library(operator.tools) # %!in% logical operator
library(tmap) # 'metro' data set
library(magrittr) # piping
library(dplyr) # exploratory data analysis verbs
library(purrr) # recursive mapping of functions
library(tibble) # improved version of a data.frame
library(ggplot2) # dot plot
library(ggrepel) # avoid label overlap
options(scipen=999)
set.seed(888)
加载示例数据并取一小部分样本
data("metro")
m_spdf <- metro
# Take a sample
m <-
metro@data %>%
as_tibble %>%
select(-name_long,-iso_a3) %>%
sample_n(50)
> m
# A tibble: 50 x 10
name pop1950 pop1960 pop1970 pop1980 pop1990
<chr> <dbl> <dbl> <dbl> <dbl> <dbl>
1 Sydney 1689935 2134673 2892477 3252111 3631940
2 Havana 1141959 1435511 1779491 1913377 2108381
3 Campinas 151977 293174 540430 1108903 1693359
4 Kano 123073 229203 541992 1349646 2095384
5 Omsk 444326 608363 829860 1032150 1143813
6 Ouagadougou 33035 59126 115374 265200 537441
7 Marseille 755805 928768 1182048 1372495 1418279
8 Taiyuan 196510 349535 621625 1105695 1636599
9 La Paz 319247 437687 600016 809218 1061850
10 Baltimore 1167656 1422067 1554538 1748983 1848834
# ... with 40 more rows, and 4 more variables:
# pop2000 <dbl>, pop2010 <dbl>, pop2020 <dbl>,
# pop2030 <dbl>
计算有和没有离群值记录的五分位数组
# Calculate the quintile groups for one variable (e.g., `pop1990`)
m_all <-
m %>%
mutate(qnt_1990_all = dplyr::ntile(pop1990,5))
# Find the outliers for a different variable (e.g., 'pop1950')
# and subset the df to exlcude these outlier records
m_out <- boxplot.stats(m$pop1950) %>% .[["out"]]
m_trim <-
m %>%
filter(pop1950 %!in% m_out) %>%
mutate(qnt_1990_trim = dplyr::ntile(pop1990,5))
# Assess whether the outlier trimming impacted the first quintile group
m_comp <-
m_trim %>%
select(name,dplyr::contains("qnt")) %>%
left_join(m_all,.,"name") %>%
select(name,dplyr::contains("qnt"),everything()) %>%
mutate(qnt_1990_chng_lgl = !is.na(qnt_1990_trim) & qnt_1990_trim != qnt_1990_all,
qnt_1990_chng_dir = if_else(qnt_1990_chng_lgl,
paste0(qnt_1990_all," to ",qnt_1990_trim),
"No change"))
在 ggplot2 的一点帮助下，我可以看到在这个例子中，六个异常值被识别出来，并且它们的遗漏不会影响 pop1990 的第一个五分位数组。
重要的是，此信息在两个新变量中进行跟踪：qnt_1990_chng_lgl 和 qnt_1990_chng_dir。
> m_comp %>% select(name,qnt_1990_chng_lgl,qnt_1990_chng_dir,everything())
# A tibble: 50 x 14
name qnt_1990_chng_lgl qnt_1990_chng_dir qnt_1990_all qnt_1990_trim
<chr> <lgl> <chr> <dbl> <dbl>
1 Sydney FALSE No change 5 NA
2 Havana TRUE 4 to 5 4 5
3 Campinas TRUE 3 to 4 3 4
4 Kano FALSE No change 4 4
5 Omsk FALSE No change 3 3
6 Ouagadougou FALSE No change 1 1
7 Marseille FALSE No change 3 3
8 Taiyuan TRUE 3 to 4 3 4
9 La Paz FALSE No change 2 2
10 Baltimore FALSE No change 4 4
# ... with 40 more rows, and 9 more variables: pop1950 <dbl>, pop1960 <dbl>,
# pop1970 <dbl>, pop1980 <dbl>, pop1990 <dbl>, pop2000 <dbl>, pop2010 <dbl>,
# pop2020 <dbl>, pop2030 <dbl>
我现在需要找到一种方法来为数据帧中的每个变量（即 pop1960 - pop2030）重复这个过程。理想情况下，将为每个现有 pop* 变量创建两个新变量，并且它们的名称将以 qnt_ 开头，然后是 _chng_dir 或 _chng_lgl.
purrr 是用于此的正确工具吗？ dplyr::mutate_？ data.table?
在我看来，您的分析没有任何问题，
这部分之后
m <- metro@data %>%
as_tibble %>%
select(-name_long,-iso_a3) %>%
sample_n(50)
只需融化您的数据并继续您的分析，但 group_by(year)
library(reshape2)
library(stringr)
mm <- melt(m)
mm[,2] <- as.factor(str_sub(mm[,2],-4))
names(mm)[2:3] <- c("year", "population")
例如，
mm %>% group_by(year) %>%
+ mutate(qnt_all = dplyr::ntile(population,5))
事实证明这个问题 是 可以使用 tidyr::gather + dplyr::group_by + tidyr::spread 函数解决。虽然 @shayaa 和 @Gregor 没有提供我正在寻找的解决方案，但他们的建议帮助我纠正了我正在研究的函数式编程方法。
我最终使用@shayaa 的 gather 和 group_by 组合，然后使用 mutate 创建变量名称（qnt_*_chng_lgl 和 qnt_*_chng_dir）和然后使用 spread 再次变宽。传递给 summarize_all 的匿名函数删除了 wide-long-wide 转换创建的所有额外 NA。
m_comp <-
m %>%
mutate(qnt = dplyr::ntile(pop1950,5)) %>%
filter(pop1950 %!in% m_out) %>%
gather(year,pop,-name,-qnt) %>%
group_by(year) %>%
mutate(qntTrim = dplyr::ntile(pop,5),
qnt_chng_lgl = !is.na(qnt) & qnt != qntTrim,
qnt_chng_dir = ifelse(qnt_chng_lgl,
paste0(qnt," to ",qntTrim),
"No change"),
year_lgl = paste0("qnt_chng_",year,"_lgl"),
year_dir = paste0("qnt_chng_",year,"_dir")) %>%
spread(year_lgl,qnt_chng_lgl) %>%
spread(year_dir,qnt_chng_dir) %>%
spread(year,pop) %>%
select(-qnt,-qntTrim) %>%
group_by(name) %>%
summarize_all(function(.){subset(.,!is.na(.)) %>% first})