2

介绍

在最近参加了 Hadley Wickham 的函数式编程课程后,我决定尝试将一些课程应用到我的工作项目中。当然,事实证明我尝试的第一个项目比课堂上演示的示例更复杂。有没有人建议使用该purrr软件包以使下面描述的任务更有效?

项目背景

我需要将五分位组分配给空间多边形数据框中的记录。除了记录标识符之外,还有其他几个变量,我需要计算每个变量的五分位组。

这是问题的症结所在:我被要求识别一个特定变量中的异常值,并在整个分析中省略这些记录, 只要它不改变任何其他变量的第一个五分位组的五分位组成

问题

我已经组装了一个 dplyr 管道(参见下面的示例),它对单个变量执行此检查过程,但是我如何重写此过程以便我可以有效地检查每个变量?

编辑:虽然作为中间步骤当然可以将数据的形状从宽更改为长,但最终它需要返回其宽格式,以便它与@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_lglqnt_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_diror _chng_lgl

purrr正确的工具吗?dplyr::mutate_? data.table?

4

2 回答 2

3

事实证明,这个问题可以使用tidyr::gather++函数dplyr::group_by解决。tidyr::spread虽然 @shayaa 和 @Gregor 没有提供我正在寻找的解决方案,但他们的建议帮助我纠正了我正在研究的函数式编程方法。

我最终使用了@shayaa's gatherandgroup_by组合,然后 mutate创建了变量名 ( qnt_*_chng_lgland qnt_*_chng_dir),然后使用spread它再次使其变宽。传递的匿名函数删除了wide-long-wide转换创建的summarize_all所有额外的。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}) 
于 2016-07-26T06:55:08.470 回答
2

在我看来,你的分析没有错,

在这部分之后

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))
于 2016-07-25T22:31:21.470 回答