dplyr cheatsheet.pdf

tidyverse 框架最大的优点在于所有函数的输入输出都是数据框,从而可以通过管道操作链式运算。

dplyr 包中filter(), mutate() 等函数参数中的表达式本质上都是以列为单位的向量化运算

操作行 Manipulate Row

return a subset of rows as a new data

  • filter() 条件筛选行
  • slice 索引切片行
  • distinct() 去重,指定以哪些列作为评价基准(其他列舍弃)
  • top_n 选择最大的n行,要指定用以比较的列
  • arrange() 排序
  • add_row 添加行
(top_n(iris, 5, Sepal.Width) %>% setDT()) # 因为并列第5都是3.9,所以筛出来6行
#>    Sepal.Length Sepal.Width Petal.Length Petal.Width Species
#> 1:          5.4         3.9          1.7         0.4  setosa
#> 2:          5.8         4.0          1.2         0.2  setosa
#> 3:          5.7         4.4          1.5         0.4  setosa
#> 4:          5.4         3.9          1.3         0.4  setosa
#> 5:          5.2         4.1          1.5         0.1  setosa
#> 6:          5.5         4.2          1.4         0.2  setosa
faithful <- as_tibble(faithful)
add_row(faithful, eruptions = 1, waiting = 1)
#> # A tibble: 273 × 2
#>    eruptions waiting
#>        <dbl>   <dbl>
#>  1      3.6       79
#>  2      1.8       54
#>  3      3.33      74
#>  4      2.28      62
#>  5      4.53      85
#>  6      2.88      55
#>  7      4.7       88
#>  8      3.6       85
#>  9      1.95      51
#> 10      4.35      85
#> # … with 263 more rows

筛选行 filter()

筛选行可以用下标实现,如flights[8:12,]head(x, n)tail(x, n)也能取最前或后若干行。但dplyr::filter()是最灵活的。

# 选取1月1日的航班
new1 <- filter(flights, month == 1, day == 1)
head(new1)
#> # A tibble: 6 × 19
#>    year month   day dep_time sched_dep_time dep_delay arr_time sched_arr_time
#>   <int> <int> <int>    <int>          <int>     <dbl>    <int>          <int>
#> 1  2013     1     1      517            515         2      830            819
#> 2  2013     1     1      533            529         4      850            830
#> 3  2013     1     1      542            540         2      923            850
#> 4  2013     1     1      544            545        -1     1004           1022
#> 5  2013     1     1      554            600        -6      812            837
#> 6  2013     1     1      554            558        -4      740            728
#> # … with 11 more variables: arr_delay <dbl>, carrier <chr>, flight <int>,
#> #   tailnum <chr>, origin <chr>, dest <chr>, air_time <dbl>, distance <dbl>,
#> #   hour <dbl>, minute <dbl>, time_hour <dttm>
# 选取11月或12月的航班,注意%in%的用法
nov_dec <- flights %>% filter(month %in% c(11, 12))
nov_dec
#> # A tibble: 55,403 × 19
#>     year month   day dep_time sched_dep_time dep_delay arr_time sched_arr_time
#>    <int> <int> <int>    <int>          <int>     <dbl>    <int>          <int>
#>  1  2013    11     1        5           2359         6      352            345
#>  2  2013    11     1       35           2250       105      123           2356
#>  3  2013    11     1      455            500        -5      641            651
#>  4  2013    11     1      539            545        -6      856            827
#>  5  2013    11     1      542            545        -3      831            855
#>  6  2013    11     1      549            600       -11      912            923
#>  7  2013    11     1      550            600       -10      705            659
#>  8  2013    11     1      554            600        -6      659            701
#>  9  2013    11     1      554            600        -6      826            827
#> 10  2013    11     1      554            600        -6      749            751
#> # … with 55,393 more rows, and 11 more variables: arr_delay <dbl>,
#> #   carrier <chr>, flight <int>, tailnum <chr>, origin <chr>, dest <chr>,
#> #   air_time <dbl>, distance <dbl>, hour <dbl>, minute <dbl>, time_hour <dttm>
# 使用管道操作
not_cancelled <- flights %>%
  filter(!is.na(dep_delay), !is.na(arr_delay))

filter() 只能筛选出条件为 TRUE 的行;它会排除那些条件为 FALSE 和 NA 的行。如果想保留缺失值,需要明确指出

索引切片 silce()

dplyr::slice(data, ...) 可以选择指定序号的行子集,正的序号表示保留,负的序号表示排除。如:

flights %>% slice(3:5)
#> # A tibble: 3 × 19
#>    year month   day dep_time sched_dep_time dep_delay arr_time sched_arr_time
#>   <int> <int> <int>    <int>          <int>     <dbl>    <int>          <int>
#> 1  2013     1     1      542            540         2      923            850
#> 2  2013     1     1      544            545        -1     1004           1022
#> 3  2013     1     1      554            600        -6      812            837
#> # … with 11 more variables: arr_delay <dbl>, carrier <chr>, flight <int>,
#> #   tailnum <chr>, origin <chr>, dest <chr>, air_time <dbl>, distance <dbl>,
#> #   hour <dbl>, minute <dbl>, time_hour <dttm>

去重行 distinct()

dplyr::distinct() 可以对数据框指定若干变量,然后筛选出所有不同值,每组不同值仅保留一行。

d.class %>% distinct(sex, age, .keep_all = TRUE)
#> # A tibble: 11 × 5
#>    name    sex     age height weight
#>    <chr>   <fct> <dbl>  <dbl>  <dbl>
#>  1 Alice   F        13   56.5   84  
#>  2 Gail    F        14   64.3   90  
#>  3 Karen   F        12   56.3   77  
#>  4 Mary    F        15   66.5  112  
#>  5 Sandy   F        11   51.3   50.5
#>  6 Alfred  M        14   69    112. 
#>  7 Guido   M        15   67    133  
#>  8 James   M        12   57.3   83  
#>  9 Jeffrey M        13   62.5   84  
#> 10 Philip  M        16   72    150  
#> 11 Thomas  M        11   57.5   85
#  .keep_all=TRUE 保留数据框中其它变量

排列行 arrange()

# 依次按year, month, day排序;默认升序
new2 <- arrange(flights, year, month, day)
head(new2)
#> # A tibble: 6 × 19
#>    year month   day dep_time sched_dep_time dep_delay arr_time sched_arr_time
#>   <int> <int> <int>    <int>          <int>     <dbl>    <int>          <int>
#> 1  2013     1     1      517            515         2      830            819
#> 2  2013     1     1      533            529         4      850            830
#> 3  2013     1     1      542            540         2      923            850
#> 4  2013     1     1      544            545        -1     1004           1022
#> 5  2013     1     1      554            600        -6      812            837
#> 6  2013     1     1      554            558        -4      740            728
#> # … with 11 more variables: arr_delay <dbl>, carrier <chr>, flight <int>,
#> #   tailnum <chr>, origin <chr>, dest <chr>, air_time <dbl>, distance <dbl>,
#> #   hour <dbl>, minute <dbl>, time_hour <dttm>
# 使用desc()可以按列进行降序排序
new2 <- arrange(flights, desc(arr_delay))
head(new2)
#> # A tibble: 6 × 19
#>    year month   day dep_time sched_dep_time dep_delay arr_time sched_arr_time
#>   <int> <int> <int>    <int>          <int>     <dbl>    <int>          <int>
#> 1  2013     1     9      641            900      1301     1242           1530
#> 2  2013     6    15     1432           1935      1137     1607           2120
#> 3  2013     1    10     1121           1635      1126     1239           1810
#> 4  2013     9    20     1139           1845      1014     1457           2210
#> 5  2013     7    22      845           1600      1005     1044           1815
#> 6  2013     4    10     1100           1900       960     1342           2211
#> # … with 11 more variables: arr_delay <dbl>, carrier <chr>, flight <int>,
#> #   tailnum <chr>, origin <chr>, dest <chr>, air_time <dbl>, distance <dbl>,
#> #   hour <dbl>, minute <dbl>, time_hour <dttm>

排序时不论升序还是降序,所有的缺失值都自动排到末尾。

操作列 Manipulate Coloum

提取列 pull()

选出一列并从数据框转化为向量,其实它就是操作符$的函数化

d.class %>% pull(name)
#>  [1] "Alice"   "Becka"   "Gail"    "Karen"   "Kathy"   "Mary"    "Sandy"  
#>  [8] "Sharon"  "Tammy"   "Alfred"  "Duke"    "Guido"   "James"   "Jeffrey"
#> [15] "John"    "Philip"  "Robert"  "Thomas"  "William"

pull()可以指定单个变量名,也可以指定变量序号,负的变量序号从最后一个变量数起。

挑选列 select()

new3 <- select(flights, year, month, day)
head(new3)
#> # A tibble: 6 × 3
#>    year month   day
#>   <int> <int> <int>
#> 1  2013     1     1
#> 2  2013     1     1
#> 3  2013     1     1
#> 4  2013     1     1
#> 5  2013     1     1
#> 6  2013     1     1
# 冒号":"选择 year 和 arr_time 之间的所有列
flights %>%
  select(year:arr_time) %>%
  head()
#> # A tibble: 6 × 7
#>    year month   day dep_time sched_dep_time dep_delay arr_time
#>   <int> <int> <int>    <int>          <int>     <dbl>    <int>
#> 1  2013     1     1      517            515         2      830
#> 2  2013     1     1      533            529         4      850
#> 3  2013     1     1      542            540         2      923
#> 4  2013     1     1      544            545        -1     1004
#> 5  2013     1     1      554            600        -6      812
#> 6  2013     1     1      554            558        -4      740
# 也可以用数字序号表示范围
flights %>%
  select(1:7) %>%
  head()
#> # A tibble: 6 × 7
#>    year month   day dep_time sched_dep_time dep_delay arr_time
#>   <int> <int> <int>    <int>          <int>     <dbl>    <int>
#> 1  2013     1     1      517            515         2      830
#> 2  2013     1     1      533            529         4      850
#> 3  2013     1     1      542            540         2      923
#> 4  2013     1     1      544            545        -1     1004
#> 5  2013     1     1      554            600        -6      812
#> 6  2013     1     1      554            558        -4      740
# 负号或!表示扣除
new3 <- select(flights, -(year:day))
head(new3)
#> # A tibble: 6 × 16
#>   dep_time sched_dep_time dep_delay arr_time sched_arr_time arr_delay carrier
#>      <int>          <int>     <dbl>    <int>          <int>     <dbl> <chr>  
#> 1      517            515         2      830            819        11 UA     
#> 2      533            529         4      850            830        20 UA     
#> 3      542            540         2      923            850        33 AA     
#> 4      544            545        -1     1004           1022       -18 B6     
#> 5      554            600        -6      812            837       -25 DL     
#> 6      554            558        -4      740            728        12 UA     
#> # … with 9 more variables: flight <int>, tailnum <chr>, origin <chr>,
#> #   dest <chr>, air_time <dbl>, distance <dbl>, hour <dbl>, minute <dbl>,
#> #   time_hour <dttm>

可以在select()的参数中使用一些辅助函数,界定符合条件的变量

  • starts_with(“abc”) 匹配以’abc’开头的名称。
  • ends_with(“xyz”) 匹配以’xyz’结尾的名称
  • contains(“ijk”) 匹配包含’ijk’的名称
  • matches(“(.)\1”) 选择匹配正则表达式的那些变量
  • num_range(“x”, 1:3) 匹配x1、x2和x3
  • one_of()
new3 <- select(flights, starts_with("c"))
head(new3)
#> # A tibble: 6 × 1
#>   carrier
#>   <chr>  
#> 1 UA     
#> 2 UA     
#> 3 AA     
#> 4 B6     
#> 5 DL     
#> 6 UA
# 如果要选择的变量名已经保存为一个字符型向量
# 可以用 one_of() 引用,直接引用向量名会报错
vars <- c("name", "sex")
d.class %>%
  select(one_of(vars))
#> # A tibble: 19 × 2
#>    name    sex  
#>    <chr>   <fct>
#>  1 Alice   F    
#>  2 Becka   F    
#>  3 Gail    F    
#>  4 Karen   F    
#>  5 Kathy   F    
#>  6 Mary    F    
#>  7 Sandy   F    
#>  8 Sharon  F    
#>  9 Tammy   F    
#> 10 Alfred  M    
#> 11 Duke    M    
#> 12 Guido   M    
#> 13 James   M    
#> 14 Jeffrey M    
#> 15 John    M    
#> 16 Philip  M    
#> 17 Robert  M    
#> 18 Thomas  M    
#> 19 William M

排列列 select(..., everything())

将select()函数和everything()辅助函数结合起来使用。当想要将几个变量移到数据框开头时,这种用法非常奏效。

new3 <- select(flights, time_hour, air_time, everything())
head(new3)
#> # A tibble: 6 × 19
#>   time_hour           air_time  year month   day dep_time sched_dep_time
#>   <dttm>                 <dbl> <int> <int> <int>    <int>          <int>
#> 1 2013-01-01 05:00:00      227  2013     1     1      517            515
#> 2 2013-01-01 05:00:00      227  2013     1     1      533            529
#> 3 2013-01-01 05:00:00      160  2013     1     1      542            540
#> 4 2013-01-01 05:00:00      183  2013     1     1      544            545
#> 5 2013-01-01 06:00:00      116  2013     1     1      554            600
#> 6 2013-01-01 05:00:00      150  2013     1     1      554            558
#> # … with 12 more variables: dep_delay <dbl>, arr_time <int>,
#> #   sched_arr_time <int>, arr_delay <dbl>, carrier <chr>, flight <int>,
#> #   tailnum <chr>, origin <chr>, dest <chr>, distance <dbl>, hour <dbl>,
#> #   minute <dbl>

重命名列 rename()

# 这个语法有点怪,前者是新列名,后者是旧列名
flights %>%
  rename(tail_num = tailnum) %>%
  head()
#> # A tibble: 6 × 19
#>    year month   day dep_time sched_dep_time dep_delay arr_time sched_arr_time
#>   <int> <int> <int>    <int>          <int>     <dbl>    <int>          <int>
#> 1  2013     1     1      517            515         2      830            819
#> 2  2013     1     1      533            529         4      850            830
#> 3  2013     1     1      542            540         2      923            850
#> 4  2013     1     1      544            545        -1     1004           1022
#> 5  2013     1     1      554            600        -6      812            837
#> 6  2013     1     1      554            558        -4      740            728
#> # … with 11 more variables: arr_delay <dbl>, carrier <chr>, flight <int>,
#> #   tail_num <chr>, origin <chr>, dest <chr>, air_time <dbl>, distance <dbl>,
#> #   hour <dbl>, minute <dbl>, time_hour <dttm>

注意这样改名字不是对原始数据框修改而是返回改了名字后的新数据框。

添加列 mutate()

以下都是向量化函数,一行一行地依次操作

  • mutate(),新变量添加在最后一列,且创建的新变量可以立即使用在参数中
  • transmute(), 如果只想保留新变量和一部分旧变量,可以使用transmute()函数,未被提及的变量不会被保留。
  • mutate_all(), 计算新列覆盖同名旧列
  • mutate_if(), 按一定条件计算新列覆盖同名旧列
  • add_column(),合并列
flights %>%
  select(year:day, ends_with("delay"), distance, air_time) %>%
  mutate(
    gain = arr_delay - dep_delay,
    hours = air_time / 60, speed = distance / hours
  )
#> # A tibble: 336,776 × 10
#>     year month   day dep_delay arr_delay distance air_time  gain hours speed
#>    <int> <int> <int>     <dbl>     <dbl>    <dbl>    <dbl> <dbl> <dbl> <dbl>
#>  1  2013     1     1         2        11     1400      227     9 3.78   370.
#>  2  2013     1     1         4        20     1416      227    16 3.78   374.
#>  3  2013     1     1         2        33     1089      160    31 2.67   408.
#>  4  2013     1     1        -1       -18     1576      183   -17 3.05   517.
#>  5  2013     1     1        -6       -25      762      116   -19 1.93   394.
#>  6  2013     1     1        -4        12      719      150    16 2.5    288.
#>  7  2013     1     1        -5        19     1065      158    24 2.63   404.
#>  8  2013     1     1        -3       -14      229       53   -11 0.883  259.
#>  9  2013     1     1        -3        -8      944      140    -5 2.33   405.
#> 10  2013     1     1        -2         8      733      138    10 2.3    319.
#> # … with 336,766 more rows
d.class %>%
  mutate(
    cheight = height - mean(height)
  )
#> # A tibble: 19 × 6
#>    name    sex     age height weight cheight
#>    <chr>   <fct> <dbl>  <dbl>  <dbl>   <dbl>
#>  1 Alice   F        13   56.5   84    -5.84 
#>  2 Becka   F        13   65.3   98     2.96 
#>  3 Gail    F        14   64.3   90     1.96 
#>  4 Karen   F        12   56.3   77    -6.04 
#>  5 Kathy   F        12   59.8   84.5  -2.54 
#>  6 Mary    F        15   66.5  112     4.16 
#>  7 Sandy   F        11   51.3   50.5 -11.0  
#>  8 Sharon  F        15   62.5  112.    0.163
#>  9 Tammy   F        14   62.8  102.    0.463
#> 10 Alfred  M        14   69    112.    6.66 
#> 11 Duke    M        14   63.5  102.    1.16 
#> 12 Guido   M        15   67    133     4.66 
#> 13 James   M        12   57.3   83    -5.04 
#> 14 Jeffrey M        13   62.5   84     0.163
#> 15 John    M        12   59     99.5  -3.34 
#> 16 Philip  M        16   72    150     9.66 
#> 17 Robert  M        12   64.8  128     2.46 
#> 18 Thomas  M        11   57.5   85    -4.84 
#> 19 William M        15   66.5  112     4.16
flights %>% transmute(dep_time,
  hour = dep_time %/% 60,
  minute = dep_time %% 60
)
#> # A tibble: 336,776 × 3
#>    dep_time  hour minute
#>       <int> <dbl>  <dbl>
#>  1      517     8     37
#>  2      533     8     53
#>  3      542     9      2
#>  4      544     9      4
#>  5      554     9     14
#>  6      554     9     14
#>  7      555     9     15
#>  8      557     9     17
#>  9      557     9     17
#> 10      558     9     18
#> # … with 336,766 more rows
mutate_all(faithful, funs(log(.), log2(.)))
#> # A tibble: 272 × 6
#>    eruptions waiting eruptions_log waiting_log eruptions_log2 waiting_log2
#>        <dbl>   <dbl>         <dbl>       <dbl>          <dbl>        <dbl>
#>  1      3.6       79         1.28         4.37          1.85          6.30
#>  2      1.8       54         0.588        3.99          0.848         5.75
#>  3      3.33      74         1.20         4.30          1.74          6.21
#>  4      2.28      62         0.825        4.13          1.19          5.95
#>  5      4.53      85         1.51         4.44          2.18          6.41
#>  6      2.88      55         1.06         4.01          1.53          5.78
#>  7      4.7       88         1.55         4.48          2.23          6.46
#>  8      3.6       85         1.28         4.44          1.85          6.41
#>  9      1.95      51         0.668        3.93          0.963         5.67
#> 10      4.35      85         1.47         4.44          2.12          6.41
#> # … with 262 more rows
iris <- as_tibble(iris)
mutate_if(iris, is.numeric, funs(log(.)))
#> # A tibble: 150 × 5
#>    Sepal.Length Sepal.Width Petal.Length Petal.Width Species
#>           <dbl>       <dbl>        <dbl>       <dbl> <fct>  
#>  1         1.63        1.25        0.336      -1.61  setosa 
#>  2         1.59        1.10        0.336      -1.61  setosa 
#>  3         1.55        1.16        0.262      -1.61  setosa 
#>  4         1.53        1.13        0.405      -1.61  setosa 
#>  5         1.61        1.28        0.336      -1.61  setosa 
#>  6         1.69        1.36        0.531      -0.916 setosa 
#>  7         1.53        1.22        0.336      -1.20  setosa 
#>  8         1.61        1.22        0.405      -1.61  setosa 
#>  9         1.48        1.06        0.336      -1.61  setosa 
#> 10         1.59        1.13        0.405      -2.30  setosa 
#> # … with 140 more rows
mutate_at(iris, vars(-Species), funs(log(.)))
#> # A tibble: 150 × 5
#>    Sepal.Length Sepal.Width Petal.Length Petal.Width Species
#>           <dbl>       <dbl>        <dbl>       <dbl> <fct>  
#>  1         1.63        1.25        0.336      -1.61  setosa 
#>  2         1.59        1.10        0.336      -1.61  setosa 
#>  3         1.55        1.16        0.262      -1.61  setosa 
#>  4         1.53        1.13        0.405      -1.61  setosa 
#>  5         1.61        1.28        0.336      -1.61  setosa 
#>  6         1.69        1.36        0.531      -0.916 setosa 
#>  7         1.53        1.22        0.336      -1.20  setosa 
#>  8         1.61        1.22        0.405      -1.61  setosa 
#>  9         1.48        1.06        0.336      -1.61  setosa 
#> 10         1.59        1.13        0.405      -2.30  setosa 
#> # … with 140 more rows
add_column(mtcars, new = 1:32)
#>                      mpg cyl  disp  hp drat    wt  qsec vs am gear carb new
#> Mazda RX4           21.0   6 160.0 110 3.90 2.620 16.46  0  1    4    4   1
#> Mazda RX4 Wag       21.0   6 160.0 110 3.90 2.875 17.02  0  1    4    4   2
#> Datsun 710          22.8   4 108.0  93 3.85 2.320 18.61  1  1    4    1   3
#> Hornet 4 Drive      21.4   6 258.0 110 3.08 3.215 19.44  1  0    3    1   4
#> Hornet Sportabout   18.7   8 360.0 175 3.15 3.440 17.02  0  0    3    2   5
#> Valiant             18.1   6 225.0 105 2.76 3.460 20.22  1  0    3    1   6
#> Duster 360          14.3   8 360.0 245 3.21 3.570 15.84  0  0    3    4   7
#> Merc 240D           24.4   4 146.7  62 3.69 3.190 20.00  1  0    4    2   8
#> Merc 230            22.8   4 140.8  95 3.92 3.150 22.90  1  0    4    2   9
#> Merc 280            19.2   6 167.6 123 3.92 3.440 18.30  1  0    4    4  10
#> Merc 280C           17.8   6 167.6 123 3.92 3.440 18.90  1  0    4    4  11
#> Merc 450SE          16.4   8 275.8 180 3.07 4.070 17.40  0  0    3    3  12
#> Merc 450SL          17.3   8 275.8 180 3.07 3.730 17.60  0  0    3    3  13
#> Merc 450SLC         15.2   8 275.8 180 3.07 3.780 18.00  0  0    3    3  14
#> Cadillac Fleetwood  10.4   8 472.0 205 2.93 5.250 17.98  0  0    3    4  15
#> Lincoln Continental 10.4   8 460.0 215 3.00 5.424 17.82  0  0    3    4  16
#> Chrysler Imperial   14.7   8 440.0 230 3.23 5.345 17.42  0  0    3    4  17
#> Fiat 128            32.4   4  78.7  66 4.08 2.200 19.47  1  1    4    1  18
#> Honda Civic         30.4   4  75.7  52 4.93 1.615 18.52  1  1    4    2  19
#> Toyota Corolla      33.9   4  71.1  65 4.22 1.835 19.90  1  1    4    1  20
#> Toyota Corona       21.5   4 120.1  97 3.70 2.465 20.01  1  0    3    1  21
#> Dodge Challenger    15.5   8 318.0 150 2.76 3.520 16.87  0  0    3    2  22
#> AMC Javelin         15.2   8 304.0 150 3.15 3.435 17.30  0  0    3    2  23
#> Camaro Z28          13.3   8 350.0 245 3.73 3.840 15.41  0  0    3    4  24
#> Pontiac Firebird    19.2   8 400.0 175 3.08 3.845 17.05  0  0    3    2  25
#> Fiat X1-9           27.3   4  79.0  66 4.08 1.935 18.90  1  1    4    1  26
#> Porsche 914-2       26.0   4 120.3  91 4.43 2.140 16.70  0  1    5    2  27
#> Lotus Europa        30.4   4  95.1 113 3.77 1.513 16.90  1  1    5    2  28
#> Ford Pantera L      15.8   8 351.0 264 4.22 3.170 14.50  0  1    5    4  29
#> Ferrari Dino        19.7   6 145.0 175 3.62 2.770 15.50  0  1    5    6  30
#> Maserati Bora       15.0   8 301.0 335 3.54 3.570 14.60  0  1    5    8  31
#> Volvo 142E          21.4   4 121.0 109 4.11 2.780 18.60  1  1    4    2  32
rename(iris, Length = Sepal.Length)
#> # A tibble: 150 × 5
#>    Length Sepal.Width Petal.Length Petal.Width Species
#>     <dbl>       <dbl>        <dbl>       <dbl> <fct>  
#>  1    5.1         3.5          1.4         0.2 setosa 
#>  2    4.9         3            1.4         0.2 setosa 
#>  3    4.7         3.2          1.3         0.2 setosa 
#>  4    4.6         3.1          1.5         0.2 setosa 
#>  5    5           3.6          1.4         0.2 setosa 
#>  6    5.4         3.9          1.7         0.4 setosa 
#>  7    4.6         3.4          1.4         0.3 setosa 
#>  8    5           3.4          1.5         0.2 setosa 
#>  9    4.4         2.9          1.4         0.2 setosa 
#> 10    4.9         3.1          1.5         0.1 setosa 
#> # … with 140 more rows

计算新列的函数

这些函数配合 mutate()transmutate(),input一个列向量,output一个列向量

顺序序号

  • seq_along(along.with) 根据输入的列的长度,产生一列从1到N的顺序序号,很像 data.table 包中的1:.N

偏移 offset

  • dplyr::lag() 后退偏移
  • dplyr::lead() 前进偏移

累计 cumulative

  • cumsum() 累计和,分组后计算1-12月累计值非常有用
  • cumprod() 累计积
  • cummin()/cummax 累计最小/大值
  • dplyr::cummean() 累计平均值
  • dplyr::cumall() 累计all(逻辑判断)
  • dplyr::cumany() 累计any(逻辑判断)

排序位置 rank

见 cheatsheet

数学运算

见 cheatsheet

其他

见 cheatsheet

df <- tibble(
  name = c("Alice", "Alice", "Bob", "Bob", "Carol", "Carol"),
  type = c("english", "math", "english", "math", "english", "math"),
  score = c(60.2, 90.5, 92.2, 98.8, 82.5, 74.6)
)

# if_else( , , ),用 ifelse( ? : )会报错
# 因为 ifelse() 不是向量化运算函数
df %>% mutate(
  assess = if_else(score > 85, "very_good", "good")
)
#> # A tibble: 6 × 4
#>   name  type    score assess   
#>   <chr> <chr>   <dbl> <chr>    
#> 1 Alice english  60.2 good     
#> 2 Alice math     90.5 very_good
#> 3 Bob   english  92.2 very_good
#> 4 Bob   math     98.8 very_good
#> 5 Carol english  82.5 good     
#> 6 Carol math     74.6 good
df %>% mutate(
  assess = case_when(
    score < 70 ~ "general",
    score >= 70 & score < 80 ~ "good",
    score >= 80 & score < 90 ~ "very_good",
    score >= 90 ~ "best",
    TRUE ~ "other"
  )
)
#> # A tibble: 6 × 4
#>   name  type    score assess   
#>   <chr> <chr>   <dbl> <chr>    
#> 1 Alice english  60.2 general  
#> 2 Alice math     90.5 best     
#> 3 Bob   english  92.2 best     
#> 4 Bob   math     98.8 best     
#> 5 Carol english  82.5 very_good
#> 6 Carol math     74.6 good

分组行 Group Row

group_by()

创建一个分好组的原数据的copy,等待进一步指令,然后分组执行。

ungroup()

逆操作,生成一个数据的 ungrouped copy

mtcars %>%
  group_by(cyl) %>%
  summarise(avg = mean(mpg))
#> # A tibble: 3 × 2
#>     cyl   avg
#>   <dbl> <dbl>
#> 1     4  26.7
#> 2     6  19.7
#> 3     8  15.1
g_iris <- group_by(iris, Species)
ungroup(g_iris)
#> # A tibble: 150 × 5
#>    Sepal.Length Sepal.Width Petal.Length Petal.Width Species
#>           <dbl>       <dbl>        <dbl>       <dbl> <fct>  
#>  1          5.1         3.5          1.4         0.2 setosa 
#>  2          4.9         3            1.4         0.2 setosa 
#>  3          4.7         3.2          1.3         0.2 setosa 
#>  4          4.6         3.1          1.5         0.2 setosa 
#>  5          5           3.6          1.4         0.2 setosa 
#>  6          5.4         3.9          1.7         0.4 setosa 
#>  7          4.6         3.4          1.4         0.3 setosa 
#>  8          5           3.4          1.5         0.2 setosa 
#>  9          4.4         2.9          1.4         0.2 setosa 
#> 10          4.9         3.1          1.5         0.1 setosa 
#> # … with 140 more rows

虽然group_by()与summarize()结合起来使用是最有效的,但分组也可以与filter()和mutate()结合,以完成非常便捷的操作:如

  • 找出每个分组中最差的成员
  • 找出大于某个阈值的所有分组
  • 对数据进行标准化以计算分组指标
# 每天到达延误时间最长的航班
flights %>%
  select(year:day, ends_with("delay"), distance, air_time) %>%
  group_by(year, month, day) %>%
  filter(rank(desc(arr_delay)) < 10)
#> # A tibble: 3,306 × 7
#> # Groups:   year, month, day [365]
#>     year month   day dep_delay arr_delay distance air_time
#>    <int> <int> <int>     <dbl>     <dbl>    <dbl>    <dbl>
#>  1  2013     1     1       853       851      184       41
#>  2  2013     1     1       290       338     1134      213
#>  3  2013     1     1       260       263      266       46
#>  4  2013     1     1       157       174      213       60
#>  5  2013     1     1       216       222      708      121
#>  6  2013     1     1       255       250      589      115
#>  7  2013     1     1       285       246     1085      146
#>  8  2013     1     1       192       191      199       44
#>  9  2013     1     1       379       456     1092      222
#> 10  2013     1     2       224       207      550       94
#> # … with 3,296 more rows
# 大于365个航班的航线
popular_dests <- flights %>%
  group_by(dest) %>%
  filter(n() > 365)
popular_dests
#> # A tibble: 332,577 × 19
#> # Groups:   dest [77]
#>     year month   day dep_time sched_dep_time dep_delay arr_time sched_arr_time
#>    <int> <int> <int>    <int>          <int>     <dbl>    <int>          <int>
#>  1  2013     1     1      517            515         2      830            819
#>  2  2013     1     1      533            529         4      850            830
#>  3  2013     1     1      542            540         2      923            850
#>  4  2013     1     1      544            545        -1     1004           1022
#>  5  2013     1     1      554            600        -6      812            837
#>  6  2013     1     1      554            558        -4      740            728
#>  7  2013     1     1      555            600        -5      913            854
#>  8  2013     1     1      557            600        -3      709            723
#>  9  2013     1     1      557            600        -3      838            846
#> 10  2013     1     1      558            600        -2      753            745
#> # … with 332,567 more rows, and 11 more variables: arr_delay <dbl>,
#> #   carrier <chr>, flight <int>, tailnum <chr>, origin <chr>, dest <chr>,
#> #   air_time <dbl>, distance <dbl>, hour <dbl>, minute <dbl>, time_hour <dttm>
# 对数据进行标准化以计算分组指标
popular_dests %>%
  filter(arr_delay > 0) %>%
  mutate(prop_delay = arr_delay / sum(arr_delay)) %>%
  select(year:day, dest, arr_delay, prop_delay)
#> # A tibble: 131,106 × 6
#> # Groups:   dest [77]
#>     year month   day dest  arr_delay prop_delay
#>    <int> <int> <int> <chr>     <dbl>      <dbl>
#>  1  2013     1     1 IAH          11  0.000111 
#>  2  2013     1     1 IAH          20  0.000201 
#>  3  2013     1     1 MIA          33  0.000235 
#>  4  2013     1     1 ORD          12  0.0000424
#>  5  2013     1     1 FLL          19  0.0000938
#>  6  2013     1     1 ORD           8  0.0000283
#>  7  2013     1     1 LAX           7  0.0000344
#>  8  2013     1     1 DFW          31  0.000282 
#>  9  2013     1     1 ATL          12  0.0000400
#> 10  2013     1     1 DTW          16  0.000116 
#> # … with 131,096 more rows

按多个变量分组

当使用多个变量进行分组时,每次的摘要统计会用掉一个分组变量。这样就可以轻松地对数据集进行循序渐进的分析。

daily <- group_by(flights, year, month, day)
(per_day <- summarize(daily, flights = n()))
#> # A tibble: 365 × 4
#> # Groups:   year, month [12]
#>     year month   day flights
#>    <int> <int> <int>   <int>
#>  1  2013     1     1     842
#>  2  2013     1     2     943
#>  3  2013     1     3     914
#>  4  2013     1     4     915
#>  5  2013     1     5     720
#>  6  2013     1     6     832
#>  7  2013     1     7     933
#>  8  2013     1     8     899
#>  9  2013     1     9     902
#> 10  2013     1    10     932
#> # … with 355 more rows
(per_month <- summarize(per_day, flights = sum(flights)))
#> # A tibble: 12 × 3
#> # Groups:   year [1]
#>     year month flights
#>    <int> <int>   <int>
#>  1  2013     1   27004
#>  2  2013     2   24951
#>  3  2013     3   28834
#>  4  2013     4   28330
#>  5  2013     5   28796
#>  6  2013     6   28243
#>  7  2013     7   29425
#>  8  2013     8   29327
#>  9  2013     9   27574
#> 10  2013    10   28889
#> 11  2013    11   27268
#> 12  2013    12   28135
(per_year <- summarize(per_month, flights = sum(flights)))
#> # A tibble: 1 × 2
#>    year flights
#>   <int>   <int>
#> 1  2013  336776

取消分组

取消分组,并回到未分组的数据继续操作,可以使用 ungroup()

daily %>%
  ungroup() %>% # 取消分组
  summarize(flights = n()) # 全年所有航班
#> # A tibble: 1 × 1
#>   flights
#>     <int>
#> 1  336776

摘要统计列 Summarize Column

summarise() 统计

  • summarize()与group_by()的组合构成了使用dplyr包时最常用的操作之一——分组摘要统计。
  • summarize()将生成一个新的数据框,包含的变量只有分组依据变量和写进summarize()参数的统计摘要变量(可以一次统计多个量)
mtcars %>% summarise(avg = mean(mpg))
#>        avg
#> 1 20.09062

count() 按该列值的 level 分组计数

df <- tibble(
  name = c("Alice", "Alice", "Bob", "Bob", "Carol", "Carol"),
  type = c("english", "math", "english", "math", "english", "math"),
  score = c(60.2, 90.5, 92.2, 98.8, 82.5, 74.6)
)

# 加权 count
df %>% count(name,
  sort = TRUE,
  wt = score,
  name = "total_score"
)
#> # A tibble: 3 × 2
#>   name  total_score
#>   <chr>       <dbl>
#> 1 Bob          191 
#> 2 Carol        157.
#> 3 Alice        151.
# 等价于
df %>%
  group_by(name) %>%
  summarise(
    n = n(),
    total_score = sum(score, na.rm = TRUE)
  ) %>%
  arrange(desc(total_score))
#> # A tibble: 3 × 3
#>   name      n total_score
#>   <chr> <int>       <dbl>
#> 1 Bob       2        191 
#> 2 Carol     2        157.
#> 3 Alice     2        151.

add_count() 增加一个 count 列

增加一列,代表每人参加的考试次数

df %>% add_count(name)
#> # A tibble: 6 × 4
#>   name  type    score     n
#>   <chr> <chr>   <dbl> <int>
#> 1 Alice english  60.2     2
#> 2 Alice math     90.5     2
#> 3 Bob   english  92.2     2
#> 4 Bob   math     98.8     2
#> 5 Carol english  82.5     2
#> 6 Carol math     74.6     2
# 等价于
df %>%
  group_by(name) %>%
  mutate(n = n()) %>%
  ungroup()
#> # A tibble: 6 × 4
#>   name  type    score     n
#>   <chr> <chr>   <dbl> <int>
#> 1 Alice english  60.2     2
#> 2 Alice math     90.5     2
#> 3 Bob   english  92.2     2
#> 4 Bob   math     98.8     2
#> 5 Carol english  82.5     2
#> 6 Carol math     74.6     2

摘要统计函数

配合在 summarise() 内部使用,占据第二个参数位置。input一个向量,output一个值。

  • sum(), mean(), cumsum()
  • 统计总/去重后/非空行数 n(), n_distinct(), sum(!is.na())
  • 定位度量 first(), last(), nth()
  • 秩的度量 min(), max(), quantile(x, 0.25)
  • 离散程度 sd()var(), mad(), IQR()

例1 观察航班数据的若干统计量

# by_date是flights按年月日分组后的新数据
by_date <- group_by(flights, year, month, day)
# 由此得到每一天的平均延误时间。
summarize(by_date, delay = mean(dep_delay, na.rm = T))
#> # A tibble: 365 × 4
#> # Groups:   year, month [12]
#>     year month   day delay
#>    <int> <int> <int> <dbl>
#>  1  2013     1     1 11.5 
#>  2  2013     1     2 13.9 
#>  3  2013     1     3 11.0 
#>  4  2013     1     4  8.95
#>  5  2013     1     5  5.73
#>  6  2013     1     6  7.15
#>  7  2013     1     7  5.42
#>  8  2013     1     8  2.55
#>  9  2013     1     9  2.28
#> 10  2013     1    10  2.84
#> # … with 355 more rows
# 也可以用管道操作写成
flights %>%
  group_by(year, month, day) %>%
  summarize(delay = mean(dep_delay, na.rm = TRUE))
#> # A tibble: 365 × 4
#> # Groups:   year, month [12]
#>     year month   day delay
#>    <int> <int> <int> <dbl>
#>  1  2013     1     1 11.5 
#>  2  2013     1     2 13.9 
#>  3  2013     1     3 11.0 
#>  4  2013     1     4  8.95
#>  5  2013     1     5  5.73
#>  6  2013     1     6  7.15
#>  7  2013     1     7  5.42
#>  8  2013     1     8  2.55
#>  9  2013     1     9  2.28
#> 10  2013     1    10  2.84
#> # … with 355 more rows
# 也可以预先去掉存在NA(航班取消)的行,写成
not_cancelled <- flights %>%
  filter(!is.na(dep_delay), !is.na(arr_delay))

not_cancelled %>%
  group_by(year, month, day) %>%
  summarize(delay = mean(dep_delay))
#> # A tibble: 365 × 4
#> # Groups:   year, month [12]
#>     year month   day delay
#>    <int> <int> <int> <dbl>
#>  1  2013     1     1 11.4 
#>  2  2013     1     2 13.7 
#>  3  2013     1     3 10.9 
#>  4  2013     1     4  8.97
#>  5  2013     1     5  5.73
#>  6  2013     1     6  7.15
#>  7  2013     1     7  5.42
#>  8  2013     1     8  2.56
#>  9  2013     1     9  2.30
#> 10  2013     1    10  2.84
#> # … with 355 more rows
# 观察平均正延误时间
not_cancelled %>%
  group_by(year, month, day) %>%
  summarize(delay_pos = mean(dep_delay[dep_delay > 0]))
#> # A tibble: 365 × 4
#> # Groups:   year, month [12]
#>     year month   day delay_pos
#>    <int> <int> <int>     <dbl>
#>  1  2013     1     1      32.6
#>  2  2013     1     2      32.4
#>  3  2013     1     3      28.3
#>  4  2013     1     4      26.2
#>  5  2013     1     5      21.8
#>  6  2013     1     6      22.1
#>  7  2013     1     7      26.2
#>  8  2013     1     8      21.3
#>  9  2013     1     9      26.5
#> 10  2013     1    10      32.6
#> # … with 355 more rows

例2 按目的地分组,按目的地分组,研究平均飞行距离与平均延误时间之间的关系

# 根据目的地分组
by_dest <- group_by(flights, dest)

# 用mean()统计平均飞行距离和平均延误时间
# 用n()统计航班数,sum(!is_na())非缺失值记数
sum_data <- summarize(by_dest,
  count = n(),
  dist = mean(distance, na.rm = TRUE),
  delay = mean(arr_delay, na.rm = TRUE)
)

# 筛选出航班数大于20(去除小样本)且目的地不为'HNL'的行
# HNL这个机场在夏威夷,距离太远属于异常值
delay <- filter(sum_data, count > 29, dest != "HNL")

# 作图
ggplot(data = delay, mapping = aes(x = dist, y = delay)) +
  geom_point(aes(size = count), alpha = 1 / 3) +
  geom_smooth(se = FALSE)

# 管道操作
# 这样写代码很清晰,每一行是一步操作
flights %>%
  group_by(dest) %>% # 分组
  summarize(
    count = n(), dist = mean(distance, na.rm = TRUE),
    delay = mean(arr_delay, na.rm = TRUE)
  ) %>% # 统计
  filter(count > 29, dest != "HNL") %>% # 筛选观测
  ggplot(mapping = aes(x = dist, y = delay)) +
  geom_point(aes(size = count), alpha = 1 / 3) +
  geom_smooth(se = FALSE) # 作图

可见,750英里内,平均延误时间会随着距离的增加而增加,接着会随着距离的增加而减少。或许,随着飞行距离的增加,延误时间有可能会在飞行中弥补回来。

例3 查看具有最长平均延误时间的航班

# 通过尾号(tailnum)对航班进行分组识别
not_cancelled %>%
  group_by(tailnum) %>%
  summarize(delay = mean(arr_delay)) %>%
  ggplot(mapping = aes(x = delay)) +
  geom_freqpoly(binwidth = 10)

有些航班的平均延误时间长达300分钟,这是怎么回事呢?

# 作航班架次数量和平均延误时间的散点图
not_cancelled %>%
  group_by(tailnum) %>%
  summarize(delay = mean(arr_delay), n = n()) %>%
  ggplot(mapping = aes(x = n, y = delay)) +
  geom_point(alpha = 0.1)

由图可见,当航班数量非常少时,平均延误时间的变动特别大。

注:这张图的形状非常能够说明问题:当绘制均值(或其他摘要统计量)和分组规模的关系时,总能看到随着样本量的增加,变动在不断减小。因此,查看此类图形时,通常应该筛选掉那些观测数量非常少的分组,这样就可以避免受到特别小的分组中的极端变动的影响,进而更好地发现数据模式

# 作去掉小样本后,航班架次数量和平均延误时间的散点图
not_cancelled %>%
  group_by(tailnum) %>%
  summarize(delay = mean(arr_delay), n = n()) %>%
  filter(n >= 30) %>%
  ggplot(mapping = aes(x = n, y = delay)) +
  geom_point(alpha = 0.1) +
  geom_smooth(method = "lm", se = FALSE)

这时我们发现,平均延误时间大多在20分钟以下;飞行架次在30以上的航班,平均延误时间最长的也只有60分钟。

例4 棒球击球手的安打率与击球次数之间的关系(能力与出场机会的关系)

# 棒球比赛数据,转换成tibble使输出更美观
batting <- as_tibble(Lahman::Batting)

# 根据球员ID分组统计,总击打数ab和安打率ba(安打数/击打数)
# 分组统计后包含playerID, ab, ba变量的新数据框为batters
batters <- batting %>%
  group_by(playerID) %>%
  summarize(
    ba = sum(H, na.rm = TRUE) / sum(AB, na.rm = TRUE),
    ab = sum(AB, na.rm = TRUE)
  )

# 按安打率排名,发现位次最靠前的是一些总击打数几乎为零、
# 靠好运气获得极高安打率的球员——而这并不表明能力强。
batters %>% arrange(desc(ba))
#> # A tibble: 19,898 × 3
#>    playerID     ba    ab
#>    <chr>     <dbl> <int>
#>  1 abramge01     1     1
#>  2 alanirj01     1     1
#>  3 alberan01     1     1
#>  4 banisje01     1     1
#>  5 bartocl01     1     1
#>  6 bassdo01      1     1
#>  7 birasst01     1     2
#>  8 bruneju01     1     1
#>  9 burnscb01     1     1
#> 10 cammaer01     1     1
#> # … with 19,888 more rows
batters %>% ggplot(mapping = aes(x = ab, y = ba)) +
  geom_point(alpha = 0.1)

# 忽略小样本,绘制安打率~击打数散点图,发现安打率基本小于35%
# 正相关关系,说明安打率较高的球员击打数较多(出场机会多)
# 由图可见,拥有20%以上的安打率,才有机会成为球队主力
batters %>%
  filter(ab > 100) %>%
  ggplot(mapping = aes(x = ab, y = ba)) +
  geom_point(alpha = 0.1) +
  geom_smooth(se = FALSE)

# 从N.Y.到其他机场飞行距离的标准差
not_cancelled %>%
  group_by(dest) %>%
  summarize(distance_sd = sd(distance)) %>%
  arrange(desc(distance_sd))
#> # A tibble: 104 × 2
#>    dest  distance_sd
#>    <chr>       <dbl>
#>  1 EGE         10.5 
#>  2 SAN         10.4 
#>  3 SFO         10.2 
#>  4 HNL         10.0 
#>  5 SEA          9.98
#>  6 LAS          9.91
#>  7 PDX          9.87
#>  8 PHX          9.86
#>  9 LAX          9.66
#> 10 IND          9.46
#> # … with 94 more rows
# 每天最早和最晚航班的出发时间
not_cancelled %>%
  group_by(year, month, day) %>%
  summarize(first = min(dep_time), last = max(dep_time))
#> # A tibble: 365 × 5
#> # Groups:   year, month [12]
#>     year month   day first  last
#>    <int> <int> <int> <int> <int>
#>  1  2013     1     1   517  2356
#>  2  2013     1     2    42  2354
#>  3  2013     1     3    32  2349
#>  4  2013     1     4    25  2358
#>  5  2013     1     5    14  2357
#>  6  2013     1     6    16  2355
#>  7  2013     1     7    49  2359
#>  8  2013     1     8   454  2351
#>  9  2013     1     9     2  2252
#> 10  2013     1    10     3  2320
#> # … with 355 more rows
# 找出每天最早和最晚出发的航班
# min_rank(x)可以返回一个序列各元素的升序位置向量
# min_rank(desc(x))返回降序位置向量
# 对出发时间排序后,用range()取出最大值和最小值
# 再用filter()取出每天出发最早和最晚的航班
not_cancelled %>%
  group_by(year, month, day) %>%
  mutate(r = min_rank(desc(dep_time))) %>%
  filter(r %in% range(r))
#> # A tibble: 770 × 20
#> # Groups:   year, month, day [365]
#>     year month   day dep_time sched_dep_time dep_delay arr_time sched_arr_time
#>    <int> <int> <int>    <int>          <int>     <dbl>    <int>          <int>
#>  1  2013     1     1      517            515         2      830            819
#>  2  2013     1     1     2356           2359        -3      425            437
#>  3  2013     1     2       42           2359        43      518            442
#>  4  2013     1     2     2354           2359        -5      413            437
#>  5  2013     1     3       32           2359        33      504            442
#>  6  2013     1     3     2349           2359       -10      434            445
#>  7  2013     1     4       25           2359        26      505            442
#>  8  2013     1     4     2358           2359        -1      429            437
#>  9  2013     1     4     2358           2359        -1      436            445
#> 10  2013     1     5       14           2359        15      503            445
#> # … with 760 more rows, and 12 more variables: arr_delay <dbl>, carrier <chr>,
#> #   flight <int>, tailnum <chr>, origin <chr>, dest <chr>, air_time <dbl>,
#> #   distance <dbl>, hour <dbl>, minute <dbl>, time_hour <dttm>, r <int>
# 纽约至哪个目的地的航线有最多的航空公司运营
# n_distinct()函数统计唯一值的数量
not_cancelled %>%
  group_by(dest) %>%
  summarize(carriers = n_distinct(carrier)) %>%
  arrange(desc(carriers))
#> # A tibble: 104 × 2
#>    dest  carriers
#>    <chr>    <int>
#>  1 ATL          7
#>  2 BOS          7
#>  3 CLT          7
#>  4 ORD          7
#>  5 TPA          7
#>  6 AUS          6
#>  7 DCA          6
#>  8 DTW          6
#>  9 IAD          6
#> 10 MSP          6
#> # … with 94 more rows
# 纽约出发的每条航线有多少个航班
not_cancelled %>% count(dest)
#> # A tibble: 104 × 2
#>    dest      n
#>    <chr> <int>
#>  1 ABQ     254
#>  2 ACK     264
#>  3 ALB     418
#>  4 ANC       8
#>  5 ATL   16837
#>  6 AUS    2411
#>  7 AVL     261
#>  8 BDL     412
#>  9 BGR     358
#> 10 BHM     269
#> # … with 94 more rows
# 加权记数,计算每个航班的总飞行距离
not_cancelled %>% count(tailnum, wt = distance)
#> # A tibble: 4,037 × 2
#>    tailnum      n
#>    <chr>    <dbl>
#>  1 D942DN    3418
#>  2 N0EGMQ  239143
#>  3 N10156  109664
#>  4 N102UW   25722
#>  5 N103US   24619
#>  6 N104UW   24616
#>  7 N10575  139903
#>  8 N105UW   23618
#>  9 N107US   21677
#> 10 N108UW   32070
#> # … with 4,027 more rows
# 若x为逻辑向量,sum(x)可以找出x中TRUE的数量,mean(x)可以找出x中TRUE的比例。
# 每天有多少架航班是早上5点前出发的
not_cancelled %>%
  group_by(year, month, day) %>%
  summarize(n_early = sum(dep_time < 500))
#> # A tibble: 365 × 4
#> # Groups:   year, month [12]
#>     year month   day n_early
#>    <int> <int> <int>   <int>
#>  1  2013     1     1       0
#>  2  2013     1     2       3
#>  3  2013     1     3       4
#>  4  2013     1     4       3
#>  5  2013     1     5       3
#>  6  2013     1     6       2
#>  7  2013     1     7       2
#>  8  2013     1     8       1
#>  9  2013     1     9       3
#> 10  2013     1    10       3
#> # … with 355 more rows
# 延误超过1小时的航班比例是多少
not_cancelled %>%
  group_by(year, month, day) %>%
  summarize(hour_perc = mean(arr_delay > 60))
#> # A tibble: 365 × 4
#> # Groups:   year, month [12]
#>     year month   day hour_perc
#>    <int> <int> <int>     <dbl>
#>  1  2013     1     1    0.0722
#>  2  2013     1     2    0.0851
#>  3  2013     1     3    0.0567
#>  4  2013     1     4    0.0396
#>  5  2013     1     5    0.0349
#>  6  2013     1     6    0.0470
#>  7  2013     1     7    0.0333
#>  8  2013     1     8    0.0213
#>  9  2013     1     9    0.0202
#> 10  2013     1    10    0.0183
#> # … with 355 more rows
LS0tDQp0aXRsZTogIuWNleihqOaVsOaNruWkhOeQhiINCnN1YnRpdGxlOiAnJw0KYXV0aG9yOiAiSHVtb29uIg0KZGF0ZTogImByIFN5cy5EYXRlKClgIg0Kb3V0cHV0OiBodG1sX2RvY3VtZW50DQpkb2N1bWVudGNsYXNzOiBjdGV4YXJ0DQpjbGFzc29wdGlvbjogaHlwZXJyZWYsDQotLS0NCg0KYGBge3Igc2V0dXAsIGluY2x1ZGU9RkFMU0V9DQpzb3VyY2UoIi4uL1JtYXJrZG93bi10ZW1wbGF0ZS9SbWFya2Rvd25fY29uZmlnLlIiKQ0KDQojIyBnbG9iYWwgb3B0aW9ucyA9PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PQ0Ka25pdHI6Om9wdHNfY2h1bmskc2V0KA0KICB3aWR0aCA9IGNvbmZpZyR3aWR0aCwNCiAgZmlnLndpZHRoID0gY29uZmlnJGZpZy53aWR0aCwNCiAgZmlnLmFzcCA9IGNvbmZpZyRmaWcuYXNwLA0KICBvdXQud2lkdGggPSBjb25maWckb3V0LndpZHRoLA0KICBmaWcuYWxpZ24gPSBjb25maWckZmlnLmFsaWduLA0KICBmaWcucGF0aCA9IGNvbmZpZyRmaWcucGF0aCwNCiAgZmlnLnNob3cgPSBjb25maWckZmlnLnNob3csDQogIHdhcm4gPSBjb25maWckd2FybiwNCiAgd2FybmluZyA9IGNvbmZpZyR3YXJuaW5nLA0KICBtZXNzYWdlID0gY29uZmlnJG1lc3NhZ2UsDQogIGVjaG8gPSBjb25maWckZWNobywNCiAgZXZhbCA9IGNvbmZpZyRldmFsLA0KICB0aWR5ID0gY29uZmlnJHRpZHksDQogIGNvbW1lbnQgPSBjb25maWckY29tbWVudCwNCiAgY29sbGFwc2UgPSBjb25maWckY29sbGFwc2UsDQogIGNhY2hlID0gY29uZmlnJGNhY2hlLA0KICBjYWNoZS5jb21tZW50cyA9IGNvbmZpZyRjYWNoZS5jb21tZW50cywNCiAgYXV0b2RlcCA9IGNvbmZpZyRhdXRvZGVwDQopDQpgYGANCg0KDQo8YSBocmVmPSIuLi9wZGYvY2hlYXRzaGVldC1kcGx5ci5wZGYiPipkcGx5ciBjaGVhdHNoZWV0LnBkZio8L2E+DQoNCjxvYmplY3QgZGF0YT0iLi4vcGRmL2NoZWF0c2hlZXQtZHBseXIucGRmIiB0eXBlPSJhcHBsaWNhdGlvbi9wZGYiIHdpZHRoPSIxMDAlIiBoZWlnaHQ9IjEwMCUiPjwvb2JqZWN0Pg0KDQoNCioqdGlkeXZlcnNlIOahhuaetuacgOWkp+eahOS8mOeCueWcqOS6juaJgOacieWHveaVsOeahOi+k+WFpei+k+WHuumDveaYr+aVsOaNruahhu+8jOS7juiAjOWPr+S7pemAmui/h+euoemBk+aTjeS9nOmTvuW8j+i/kOeul+OAgioqDQoNCioqZHBseXIg5YyF5LitYGZpbHRlcigpYCwgYG11dGF0ZSgpYCDnrYnlh73mlbDlj4LmlbDkuK3nmoTooajovr7lvI/mnKzotKjkuIrpg73mmK/ku6XliJfkuLrljZXkvY3nmoTlkJHph4/ljJbov5DnrpcqKg0KDQpgYGB7ciwgZWNobz1GQUxTRX0NCmxpYnJhcnkoInJlc2hhcGUyIikNCmxpYnJhcnkoIm55Y2ZsaWdodHMxMyIpDQojIOiLpemcgOWcqOihjOWGheaPkuWFpeaVsOWAvO+8jOiHquWumuS5ieS/neeVmeWwj+aVsOS9jeaVsOOAgeWinuWKoOWNg+S9jeWIhumalOespueahOWHveaVsGNvbW1hDQpjb21tYSA8LSBmdW5jdGlvbih4KSBmb3JtYXQoeCwgZGlnaXRzID0gMiwgYmlnLm1hcmsgPSAiLCIpDQoNCiMjIOaVsOaNruWHhuWkhw0KIyBueWNmbGlnaHRzMTM6OmZsaWdodHMgIyBmbGlnaHRzIGRlcGFydCBmcm9tIE5ldyBZb3JrIGluIDIwMTMNCmQuY2xhc3MgPC0NCiAgcmVhZF9jc3YoImNsYXNzLmNzdiIsDQogICAgY29sX3R5cGVzID0gY29scygNCiAgICAgIC5kZWZhdWx0ID0gY29sX2RvdWJsZSgpLA0KICAgICAgbmFtZSA9IGNvbF9jaGFyYWN0ZXIoKSwNCiAgICAgIHNleCA9IGNvbF9mYWN0b3IobGV2ZWxzID0gYygiTSIsICJGIikpDQogICAgKQ0KICApDQpsaWJyYXJ5KE5IQU5FUykNCmRhdGEoTkhBTkVTKQ0KYGBgDQoNCiMjIOaTjeS9nOihjCBNYW5pcHVsYXRlIFJvdw0KDQpyZXR1cm4gYSBzdWJzZXQgb2Ygcm93cyBhcyBhIG5ldyBkYXRhDQoNCi0gICBgZmlsdGVyKClgIOadoeS7tuetm+mAieihjA0KLSAgIGBzbGljZWAg57Si5byV5YiH54mH6KGMDQotICAgYGRpc3RpbmN0KClgIOWOu+mHje+8jOaMh+WumuS7peWTquS6m+WIl+S9nOS4uuivhOS7t+WfuuWHhu+8iOWFtuS7luWIl+iIjeW8g++8iQ0KLSAgIGB0b3BfbmAg6YCJ5oup5pyA5aSn55qEbuihjO+8jOimgeaMh+WumueUqOS7peavlOi+g+eahOWIlw0KLSAgIGBhcnJhbmdlKClgIOaOkuW6jw0KLSAgIGBhZGRfcm93YCDmt7vliqDooYwNCg0KYGBge3J9DQoodG9wX24oaXJpcywgNSwgU2VwYWwuV2lkdGgpICU+JSBzZXREVCgpKSAjIOWboOS4uuW5tuWIl+esrDXpg73mmK8zLjnvvIzmiYDku6XnrZvlh7rmnaU26KGMDQpmYWl0aGZ1bCA8LSBhc190aWJibGUoZmFpdGhmdWwpDQphZGRfcm93KGZhaXRoZnVsLCBlcnVwdGlvbnMgPSAxLCB3YWl0aW5nID0gMSkNCmBgYA0KDQoNCiMjIyDnrZvpgInooYwgYGZpbHRlcigpYA0KDQrnrZvpgInooYzlj6/ku6XnlKjkuIvmoIflrp7njrDvvIzlpoJgZmxpZ2h0c1s4OjEyLF1g77yMYGhlYWQoeCwgbilg5ZKMYHRhaWwoeCwgbilg5Lmf6IO95Y+W5pyA5YmN5oiW5ZCO6Iul5bmy6KGM44CC5L2GYGRwbHlyOjpmaWx0ZXIoKWDmmK/mnIDngbXmtLvnmoTjgIINCg0KYGBge3IgZmlsdGVyMX0NCiMg6YCJ5Y+WMeaciDHml6XnmoToiKrnj60NCm5ldzEgPC0gZmlsdGVyKGZsaWdodHMsIG1vbnRoID09IDEsIGRheSA9PSAxKQ0KaGVhZChuZXcxKQ0KDQojIOmAieWPljEx5pyI5oiWMTLmnIjnmoToiKrnj63vvIzms6jmhI8laW4l55qE55So5rOVDQpub3ZfZGVjIDwtIGZsaWdodHMgJT4lIGZpbHRlcihtb250aCAlaW4lIGMoMTEsIDEyKSkNCm5vdl9kZWMNCg0KIyDkvb/nlKjnrqHpgZPmk43kvZwNCm5vdF9jYW5jZWxsZWQgPC0gZmxpZ2h0cyAlPiUNCiAgZmlsdGVyKCFpcy5uYShkZXBfZGVsYXkpLCAhaXMubmEoYXJyX2RlbGF5KSkNCmBgYA0KDQpmaWx0ZXIoKSDlj6rog73nrZvpgInlh7rmnaHku7bkuLogVFJVRSDnmoTooYzvvJvlroPkvJrmjpLpmaTpgqPkupvmnaHku7bkuLogRkFMU0UgKirlkowgTkEg55qE6KGM44CC5aaC5p6c5oOz5L+d55WZ57y65aSx5YC877yM6ZyA6KaB5piO56Gu5oyH5Ye6KirjgIINCg0KIyMjIOe0ouW8leWIh+eJhyBgc2lsY2UoKWANCg0KYGRwbHlyOjpzbGljZShkYXRhLCAuLi4pYCDlj6/ku6XpgInmi6nmjIflrprluo/lj7fnmoTooYzlrZDpm4bvvIzmraPnmoTluo/lj7fooajnpLrkv53nlZnvvIzotJ/nmoTluo/lj7fooajnpLrmjpLpmaTjgILlpoLvvJoNCmBgYHtyfQ0KZmxpZ2h0cyAlPiUgc2xpY2UoMzo1KQ0KYGBgDQoNCiMjIyDljrvph43ooYwgYGRpc3RpbmN0KClgDQoNCmBkcGx5cjo6ZGlzdGluY3QoKWAg5Y+v5Lul5a+55pWw5o2u5qGG5oyH5a6a6Iul5bmy5Y+Y6YeP77yM54S25ZCO562b6YCJ5Ye65omA5pyJ5LiN5ZCM5YC877yM5q+P57uE5LiN5ZCM5YC85LuF5L+d55WZ5LiA6KGM44CCDQpgYGB7cn0NCmQuY2xhc3MgJT4lIGRpc3RpbmN0KHNleCwgYWdlLCAua2VlcF9hbGwgPSBUUlVFKQ0KIyAgLmtlZXBfYWxsPVRSVUUg5L+d55WZ5pWw5o2u5qGG5Lit5YW25a6D5Y+Y6YePDQpgYGANCg0KDQojIyMg5o6S5YiX6KGMIGBhcnJhbmdlKClgDQoNCmBgYHtyIGFycmFuZ2V9DQojIOS+neasoeaMiXllYXIsIG1vbnRoLCBkYXnmjpLluo/vvJvpu5jorqTljYfluo8NCm5ldzIgPC0gYXJyYW5nZShmbGlnaHRzLCB5ZWFyLCBtb250aCwgZGF5KQ0KaGVhZChuZXcyKQ0KDQojIOS9v+eUqGRlc2MoKeWPr+S7peaMieWIl+i/m+ihjOmZjeW6j+aOkuW6jw0KbmV3MiA8LSBhcnJhbmdlKGZsaWdodHMsIGRlc2MoYXJyX2RlbGF5KSkNCmhlYWQobmV3MikNCmBgYA0K5o6S5bqP5pe25LiN6K665Y2H5bqP6L+Y5piv6ZmN5bqP77yM5omA5pyJ55qE57y65aSx5YC86YO96Ieq5Yqo5o6S5Yiw5pyr5bC+44CCDQoNCg0KIyMg5pON5L2c5YiXIE1hbmlwdWxhdGUgQ29sb3VtDQoNCg0KIyMjIOaPkOWPluWIlyBgcHVsbCgpYA0KDQrpgInlh7rkuIDliJflubbku47mlbDmja7moYYqKui9rOWMluS4uuWQkemHjyoq77yM5YW25a6e5a6D5bCx5piv5pON5L2c56ymYCRg55qE5Ye95pWw5YyWDQoNCmBgYHtyfQ0KZC5jbGFzcyAlPiUgcHVsbChuYW1lKQ0KYGBgDQoNCmBwdWxsKClg5Y+v5Lul5oyH5a6a5Y2V5Liq5Y+Y6YeP5ZCN77yM5Lmf5Y+v5Lul5oyH5a6a5Y+Y6YeP5bqP5Y+377yM6LSf55qE5Y+Y6YeP5bqP5Y+35LuO5pyA5ZCO5LiA5Liq5Y+Y6YeP5pWw6LW344CCDQoNCg0KIyMjIOaMkemAieWIlyBgc2VsZWN0KClgDQoNCmBgYHtyIHNlbGVjdDF9DQpuZXczIDwtIHNlbGVjdChmbGlnaHRzLCB5ZWFyLCBtb250aCwgZGF5KQ0KaGVhZChuZXczKQ0KDQojIOWGkuWPtyI6IumAieaLqSB5ZWFyIOWSjCBhcnJfdGltZSDkuYvpl7TnmoTmiYDmnInliJcNCmZsaWdodHMgJT4lDQogIHNlbGVjdCh5ZWFyOmFycl90aW1lKSAlPiUNCiAgaGVhZCgpDQoNCiMg5Lmf5Y+v5Lul55So5pWw5a2X5bqP5Y+36KGo56S66IyD5Zu0DQpmbGlnaHRzICU+JQ0KICBzZWxlY3QoMTo3KSAlPiUNCiAgaGVhZCgpDQoNCiMg6LSf5Y+35oiWIeihqOekuuaJo+mZpA0KbmV3MyA8LSBzZWxlY3QoZmxpZ2h0cywgLSh5ZWFyOmRheSkpDQpoZWFkKG5ldzMpDQpgYGANCg0K5Y+v5Lul5Zyoc2VsZWN0KCnnmoTlj4LmlbDkuK3kvb/nlKjkuIDkupvovoXliqnlh73mlbDvvIznlYzlrprnrKblkIjmnaHku7bnmoTlj5jph48NCg0KKiBzdGFydHNfd2l0aCgiYWJjIikg5Yy56YWN5LulJ2FiYyflvIDlpLTnmoTlkI3np7DjgIINCiogZW5kc193aXRoKCJ4eXoiKSDljLnphY3ku6UneHl6J+e7k+WwvueahOWQjeensA0KKiBjb250YWlucygiaWprIikg5Yy56YWN5YyF5ZCrJ2lqayfnmoTlkI3np7ANCiogbWF0Y2hlcygiKC4pXFwxIikg6YCJ5oup5Yy56YWN5q2j5YiZ6KGo6L6+5byP55qE6YKj5Lqb5Y+Y6YePDQoqIG51bV9yYW5nZSgieCIsIDE6Mykg5Yy56YWNeDHjgIF4MuWSjHgzDQotIG9uZV9vZigpDQoNCmBgYHtyIHNlbGVjdDJ9DQpuZXczIDwtIHNlbGVjdChmbGlnaHRzLCBzdGFydHNfd2l0aCgiYyIpKQ0KaGVhZChuZXczKQ0KDQojIOWmguaenOimgemAieaLqeeahOWPmOmHj+WQjeW3sue7j+S/neWtmOS4uuS4gOS4quWtl+espuWei+WQkemHjw0KIyDlj6/ku6XnlKggb25lX29mKCkg5byV55So77yM55u05o6l5byV55So5ZCR6YeP5ZCN5Lya5oql6ZSZDQp2YXJzIDwtIGMoIm5hbWUiLCAic2V4IikNCmQuY2xhc3MgJT4lDQogIHNlbGVjdChvbmVfb2YodmFycykpDQpgYGANCg0KIyMjIOaOkuWIl+WIlyBgc2VsZWN0KC4uLiwgIGV2ZXJ5dGhpbmcoKSlgDQoNCuWwhnNlbGVjdCgp5Ye95pWw5ZKMZXZlcnl0aGluZygp6L6F5Yqp5Ye95pWw57uT5ZCI6LW35p2l5L2/55So44CC5b2T5oOz6KaB5bCG5Yeg5Liq5Y+Y6YeP56e75Yiw5pWw5o2u5qGG5byA5aS05pe277yM6L+Z56eN55So5rOV6Z2e5bi45aWP5pWI44CCDQpgYGB7ciBzZWxlY3Q0fQ0KbmV3MyA8LSBzZWxlY3QoZmxpZ2h0cywgdGltZV9ob3VyLCBhaXJfdGltZSwgZXZlcnl0aGluZygpKQ0KaGVhZChuZXczKQ0KYGBgDQoNCiMjIyDph43lkb3lkI3liJcgYHJlbmFtZSgpYA0KDQpgYGB7ciBzZWxlY3QzfQ0KIyDov5nkuKror63ms5XmnInngrnmgKrvvIzliY3ogIXmmK/mlrDliJflkI3vvIzlkI7ogIXmmK/ml6fliJflkI0NCmZsaWdodHMgJT4lDQogIHJlbmFtZSh0YWlsX251bSA9IHRhaWxudW0pICU+JQ0KICBoZWFkKCkNCmBgYA0KDQrms6jmhI/ov5nmoLfmlLnlkI3lrZfkuI3mmK/lr7nljp/lp4vmlbDmja7moYbkv67mlLnogIzmmK/ov5Tlm57mlLnkuoblkI3lrZflkI7nmoTmlrDmlbDmja7moYbjgIINCg0KDQojIyMg5re75Yqg5YiXIGBtdXRhdGUoKWANCg0KDQrku6XkuIvpg73mmK/lkJHph4/ljJblh73mlbDvvIzkuIDooYzkuIDooYzlnLDkvp3mrKHmk43kvZwNCg0KLSAgIGBtdXRhdGUoKWDvvIzmlrDlj5jph4/mt7vliqDlnKjmnIDlkI7kuIDliJfvvIzkuJTliJvlu7rnmoTmlrDlj5jph4/lj6/ku6Xnq4vljbPkvb/nlKjlnKjlj4LmlbDkuK0NCi0gICBgdHJhbnNtdXRlKClgLCDlpoLmnpzlj6rmg7Pkv53nlZnmlrDlj5jph4/lkozkuIDpg6jliIbml6flj5jph4/vvIzlj6/ku6Xkvb/nlKh0cmFuc211dGUoKeWHveaVsO+8jOacquiiq+aPkOWPiueahOWPmOmHj+S4jeS8muiiq+S/neeVmeOAgg0KLSAgIGBtdXRhdGVfYWxsKClgLCDorqHnrpfmlrDliJfopobnm5blkIzlkI3ml6fliJcNCi0gICBgbXV0YXRlX2lmKClgLCDmjInkuIDlrprmnaHku7borqHnrpfmlrDliJfopobnm5blkIzlkI3ml6fliJcNCi0gICBgYWRkX2NvbHVtbigpYO+8jOWQiOW5tuWIlw0KDQpgYGB7cn0NCmZsaWdodHMgJT4lDQogIHNlbGVjdCh5ZWFyOmRheSwgZW5kc193aXRoKCJkZWxheSIpLCBkaXN0YW5jZSwgYWlyX3RpbWUpICU+JQ0KICBtdXRhdGUoDQogICAgZ2FpbiA9IGFycl9kZWxheSAtIGRlcF9kZWxheSwNCiAgICBob3VycyA9IGFpcl90aW1lIC8gNjAsIHNwZWVkID0gZGlzdGFuY2UgLyBob3Vycw0KICApDQoNCmQuY2xhc3MgJT4lDQogIG11dGF0ZSgNCiAgICBjaGVpZ2h0ID0gaGVpZ2h0IC0gbWVhbihoZWlnaHQpDQogICkNCg0KZmxpZ2h0cyAlPiUgdHJhbnNtdXRlKGRlcF90aW1lLA0KICBob3VyID0gZGVwX3RpbWUgJS8lIDYwLA0KICBtaW51dGUgPSBkZXBfdGltZSAlJSA2MA0KKQ0KDQptdXRhdGVfYWxsKGZhaXRoZnVsLCBmdW5zKGxvZyguKSwgbG9nMiguKSkpDQoNCmlyaXMgPC0gYXNfdGliYmxlKGlyaXMpDQptdXRhdGVfaWYoaXJpcywgaXMubnVtZXJpYywgZnVucyhsb2coLikpKQ0KbXV0YXRlX2F0KGlyaXMsIHZhcnMoLVNwZWNpZXMpLCBmdW5zKGxvZyguKSkpDQphZGRfY29sdW1uKG10Y2FycywgbmV3ID0gMTozMikNCnJlbmFtZShpcmlzLCBMZW5ndGggPSBTZXBhbC5MZW5ndGgpDQpgYGANCg0KDQojIyMg6K6h566X5paw5YiX55qE5Ye95pWwDQoNCui/meS6m+WHveaVsOmFjeWQiCBgbXV0YXRlKClgIOWSjCBgdHJhbnNtdXRhdGUoKWDvvIxpbnB1dOS4gOS4quWIl+WQkemHj++8jG91dHB1dOS4gOS4quWIl+WQkemHjw0KDQojIyMjIOmhuuW6j+W6j+WPtw0KDQotIGBzZXFfYWxvbmcoYWxvbmcud2l0aClgIOagueaNrui+k+WFpeeahOWIl+eahOmVv+W6pu+8jOS6p+eUn+S4gOWIl+S7jjHliLBO55qE6aG65bqP5bqP5Y+377yM5b6I5YOPIGRhdGEudGFibGUg5YyF5Lit55qEYDE6Lk5gDQoNCiMjIyMg5YGP56e7IG9mZnNldA0KDQotICAgYGRwbHlyOjpsYWcoKWAg5ZCO6YCA5YGP56e7DQotICAgYGRwbHlyOjpsZWFkKClgIOWJjei/m+WBj+enuw0KDQojIyMjIOe0r+iuoSBjdW11bGF0aXZlDQoNCi0gICBgY3Vtc3VtKClgIOe0r+iuoeWSjO+8jOWIhue7hOWQjuiuoeeulzEtMTLmnIjntK/orqHlgLzpnZ7luLjmnInnlKgNCi0gICBgY3VtcHJvZCgpYCDntK/orqHnp68NCi0gICBgY3VtbWluKCkvY3VtbWF4YCDntK/orqHmnIDlsI8v5aSn5YC8DQotICAgYGRwbHlyOjpjdW1tZWFuKClgIOe0r+iuoeW5s+Wdh+WAvA0KLSAgIGBkcGx5cjo6Y3VtYWxsKClgIOe0r+iuoWFsbO+8iOmAu+i+keWIpOaWre+8iQ0KLSAgIGBkcGx5cjo6Y3VtYW55KClgIOe0r+iuoWFuee+8iOmAu+i+keWIpOaWre+8iQ0KDQojIyMjIOaOkuW6j+S9jee9riByYW5rDQoNCuingSBjaGVhdHNoZWV0DQoNCiMjIyMg5pWw5a2m6L+Q566XDQoNCuingSBjaGVhdHNoZWV0DQoNCiMjIyMg5YW25LuWDQoNCuingSBjaGVhdHNoZWV0DQoNCmBgYHtyfQ0KZGYgPC0gdGliYmxlKA0KICBuYW1lID0gYygiQWxpY2UiLCAiQWxpY2UiLCAiQm9iIiwgIkJvYiIsICJDYXJvbCIsICJDYXJvbCIpLA0KICB0eXBlID0gYygiZW5nbGlzaCIsICJtYXRoIiwgImVuZ2xpc2giLCAibWF0aCIsICJlbmdsaXNoIiwgIm1hdGgiKSwNCiAgc2NvcmUgPSBjKDYwLjIsIDkwLjUsIDkyLjIsIDk4LjgsIDgyLjUsIDc0LjYpDQopDQoNCiMgaWZfZWxzZSggLCAsICnvvIznlKggaWZlbHNlKCA/IDogKeS8muaKpemUmQ0KIyDlm6DkuLogaWZlbHNlKCkg5LiN5piv5ZCR6YeP5YyW6L+Q566X5Ye95pWwDQpkZiAlPiUgbXV0YXRlKA0KICBhc3Nlc3MgPSBpZl9lbHNlKHNjb3JlID4gODUsICJ2ZXJ5X2dvb2QiLCAiZ29vZCIpDQopDQoNCg0KZGYgJT4lIG11dGF0ZSgNCiAgYXNzZXNzID0gY2FzZV93aGVuKA0KICAgIHNjb3JlIDwgNzAgfiAiZ2VuZXJhbCIsDQogICAgc2NvcmUgPj0gNzAgJiBzY29yZSA8IDgwIH4gImdvb2QiLA0KICAgIHNjb3JlID49IDgwICYgc2NvcmUgPCA5MCB+ICJ2ZXJ5X2dvb2QiLA0KICAgIHNjb3JlID49IDkwIH4gImJlc3QiLA0KICAgIFRSVUUgfiAib3RoZXIiDQogICkNCikNCmBgYA0KDQoNCg0KIyMg5YiG57uE6KGMIEdyb3VwIFJvdw0KDQojIyMjIGBncm91cF9ieSgpYA0KDQrliJvlu7rkuIDkuKrliIblpb3nu4TnmoTljp/mlbDmja7nmoRjb3B577yM562J5b6F6L+b5LiA5q2l5oyH5Luk77yM54S25ZCO5YiG57uE5omn6KGM44CCDQoNCiMjIyMgYHVuZ3JvdXAoKWAgDQoNCumAhuaTjeS9nO+8jOeUn+aIkOS4gOS4quaVsOaNrueahCB1bmdyb3VwZWQgY29weQ0KDQpgYGB7cn0NCm10Y2FycyAlPiUNCiAgZ3JvdXBfYnkoY3lsKSAlPiUNCiAgc3VtbWFyaXNlKGF2ZyA9IG1lYW4obXBnKSkNCmdfaXJpcyA8LSBncm91cF9ieShpcmlzLCBTcGVjaWVzKQ0KdW5ncm91cChnX2lyaXMpDQpgYGANCg0K6Jm954S2Z3JvdXBfYnkoKeS4jnN1bW1hcml6ZSgp57uT5ZCI6LW35p2l5L2/55So5piv5pyA5pyJ5pWI55qE77yM5L2G5YiG57uE5Lmf5Y+v5Lul5LiOZmlsdGVyKCnlkoxtdXRhdGUoKee7k+WQiO+8jOS7peWujOaIkOmdnuW4uOS+v+aNt+eahOaTjeS9nO+8muWmgg0KDQoqIOaJvuWHuuavj+S4quWIhue7hOS4reacgOW3rueahOaIkOWRmA0KKiDmib7lh7rlpKfkuo7mn5DkuKrpmIjlgLznmoTmiYDmnInliIbnu4QNCiog5a+55pWw5o2u6L+b6KGM5qCH5YeG5YyW5Lul6K6h566X5YiG57uE5oyH5qCHDQoNCmBgYHtyfQ0KIyDmr4/lpKnliLDovr7lu7bor6/ml7bpl7TmnIDplb/nmoToiKrnj60NCmZsaWdodHMgJT4lDQogIHNlbGVjdCh5ZWFyOmRheSwgZW5kc193aXRoKCJkZWxheSIpLCBkaXN0YW5jZSwgYWlyX3RpbWUpICU+JQ0KICBncm91cF9ieSh5ZWFyLCBtb250aCwgZGF5KSAlPiUNCiAgZmlsdGVyKHJhbmsoZGVzYyhhcnJfZGVsYXkpKSA8IDEwKQ0KDQojIOWkp+S6jjM2NeS4quiIquePreeahOiIque6vw0KcG9wdWxhcl9kZXN0cyA8LSBmbGlnaHRzICU+JQ0KICBncm91cF9ieShkZXN0KSAlPiUNCiAgZmlsdGVyKG4oKSA+IDM2NSkNCnBvcHVsYXJfZGVzdHMNCg0KIyDlr7nmlbDmja7ov5vooYzmoIflh4bljJbku6XorqHnrpfliIbnu4TmjIfmoIcNCnBvcHVsYXJfZGVzdHMgJT4lDQogIGZpbHRlcihhcnJfZGVsYXkgPiAwKSAlPiUNCiAgbXV0YXRlKHByb3BfZGVsYXkgPSBhcnJfZGVsYXkgLyBzdW0oYXJyX2RlbGF5KSkgJT4lDQogIHNlbGVjdCh5ZWFyOmRheSwgZGVzdCwgYXJyX2RlbGF5LCBwcm9wX2RlbGF5KQ0KYGBgDQoNCiMjIyDmjInlpJrkuKrlj5jph4/liIbnu4QNCg0K5b2T5L2/55So5aSa5Liq5Y+Y6YeP6L+b6KGM5YiG57uE5pe277yM5q+P5qyh55qE5pGY6KaB57uf6K6h5Lya55So5o6J5LiA5Liq5YiG57uE5Y+Y6YeP44CC6L+Z5qC35bCx5Y+v5Lul6L275p2+5Zyw5a+55pWw5o2u6ZuG6L+b6KGM5b6q5bqP5riQ6L+b55qE5YiG5p6Q44CCDQoNCmBgYHtyIG11bHRpZ3JvdXB9DQpkYWlseSA8LSBncm91cF9ieShmbGlnaHRzLCB5ZWFyLCBtb250aCwgZGF5KQ0KKHBlcl9kYXkgPC0gc3VtbWFyaXplKGRhaWx5LCBmbGlnaHRzID0gbigpKSkNCihwZXJfbW9udGggPC0gc3VtbWFyaXplKHBlcl9kYXksIGZsaWdodHMgPSBzdW0oZmxpZ2h0cykpKQ0KKHBlcl95ZWFyIDwtIHN1bW1hcml6ZShwZXJfbW9udGgsIGZsaWdodHMgPSBzdW0oZmxpZ2h0cykpKQ0KYGBgDQoNCiMjIyDlj5bmtojliIbnu4QNCg0K5Y+W5raI5YiG57uE77yM5bm25Zue5Yiw5pyq5YiG57uE55qE5pWw5o2u57un57ut5pON5L2c77yM5Y+v5Lul5L2/55SoIHVuZ3JvdXAoKQ0KYGBge3IgdW5ncm91cCwgZGVwZW5kc29uPSdtdWx0aWdyb3VwJ30NCmRhaWx5ICU+JQ0KICB1bmdyb3VwKCkgJT4lICMg5Y+W5raI5YiG57uEDQogIHN1bW1hcml6ZShmbGlnaHRzID0gbigpKSAjIOWFqOW5tOaJgOacieiIquePrQ0KYGBgDQoNCiMjIOaRmOimgee7n+iuoeWIlyBTdW1tYXJpemUgQ29sdW1uDQoNCiMjIyMgYHN1bW1hcmlzZSgpYCDnu5/orqENCg0KKiAqKnN1bW1hcml6ZSgp5LiOZ3JvdXBfYnkoKeeahOe7hOWQiOaehOaIkOS6huS9v+eUqGRwbHly5YyF5pe25pyA5bi455So55qE5pON5L2c5LmL5LiA4oCU4oCU5YiG57uE5pGY6KaB57uf6K6h44CCKioNCiogc3VtbWFyaXplKCnlsIbnlJ/miJDkuIDkuKrmlrDnmoTmlbDmja7moYbvvIzljIXlkKvnmoTlj5jph4/lj6rmnInliIbnu4Tkvp3mja7lj5jph4/lkozlhpnov5tzdW1tYXJpemUoKeWPguaVsOeahOe7n+iuoeaRmOimgeWPmOmHj++8iOWPr+S7peS4gOasoee7n+iuoeWkmuS4qumHj++8iQ0KDQpgYGB7cn0NCm10Y2FycyAlPiUgc3VtbWFyaXNlKGF2ZyA9IG1lYW4obXBnKSkNCmBgYA0KDQoNCg0KIyMjIyBgY291bnQoKWAg5oyJ6K+l5YiX5YC855qEIGxldmVsIOWIhue7hOiuoeaVsA0KDQpgYGB7cn0NCmRmIDwtIHRpYmJsZSgNCiAgbmFtZSA9IGMoIkFsaWNlIiwgIkFsaWNlIiwgIkJvYiIsICJCb2IiLCAiQ2Fyb2wiLCAiQ2Fyb2wiKSwNCiAgdHlwZSA9IGMoImVuZ2xpc2giLCAibWF0aCIsICJlbmdsaXNoIiwgIm1hdGgiLCAiZW5nbGlzaCIsICJtYXRoIiksDQogIHNjb3JlID0gYyg2MC4yLCA5MC41LCA5Mi4yLCA5OC44LCA4Mi41LCA3NC42KQ0KKQ0KDQojIOWKoOadgyBjb3VudA0KZGYgJT4lIGNvdW50KG5hbWUsDQogIHNvcnQgPSBUUlVFLA0KICB3dCA9IHNjb3JlLA0KICBuYW1lID0gInRvdGFsX3Njb3JlIg0KKQ0KDQojIOetieS7t+S6jg0KZGYgJT4lDQogIGdyb3VwX2J5KG5hbWUpICU+JQ0KICBzdW1tYXJpc2UoDQogICAgbiA9IG4oKSwNCiAgICB0b3RhbF9zY29yZSA9IHN1bShzY29yZSwgbmEucm0gPSBUUlVFKQ0KICApICU+JQ0KICBhcnJhbmdlKGRlc2ModG90YWxfc2NvcmUpKQ0KYGBgDQoNCiMjIyMgYGFkZF9jb3VudCgpYCDlop7liqDkuIDkuKogY291bnQg5YiXDQoNCuWinuWKoOS4gOWIl++8jOS7o+ihqOavj+S6uuWPguWKoOeahOiAg+ivleasoeaVsA0KDQpgYGB7cn0NCmRmICU+JSBhZGRfY291bnQobmFtZSkNCg0KIyDnrYnku7fkuo4NCmRmICU+JQ0KICBncm91cF9ieShuYW1lKSAlPiUNCiAgbXV0YXRlKG4gPSBuKCkpICU+JQ0KICB1bmdyb3VwKCkNCmBgYA0KDQoNCg0KIyMjIOaRmOimgee7n+iuoeWHveaVsA0KDQrphY3lkIjlnKggYHN1bW1hcmlzZSgpYCDlhoXpg6jkvb/nlKjvvIzljaDmja7nrKzkuozkuKrlj4LmlbDkvY3nva7jgIJpbnB1dOS4gOS4quWQkemHj++8jG91dHB1dOS4gOS4quWAvOOAgg0KDQotICAgYHN1bSgpYCwgYG1lYW4oKWAsIGBjdW1zdW0oKWANCi0gICDnu5/orqHmgLsv5Y676YeN5ZCOL+mdnuepuuihjOaVsCBgbigpYCwgYG5fZGlzdGluY3QoKWAsIGBzdW0oIWlzLm5hKCkpYA0KLSAgIOWumuS9jeW6pumHjyBgZmlyc3QoKWAsIGBsYXN0KClgLCBgbnRoKClgDQotICAg56ep55qE5bqm6YePIGBtaW4oKWAsIGBtYXgoKWAsIGBxdWFudGlsZSh4LCAwLjI1KWANCi0gICDnprvmlaPnqIvluqYgYHNkKClg44CBYHZhcigpYCwgYG1hZCgpYCwgYElRUigpYA0KDQrkvosxIOinguWvn+iIquePreaVsOaNrueahOiLpeW5sue7n+iuoemHjw0KYGBge3IgZXhhbXBsZTF9DQojIGJ5X2RhdGXmmK9mbGlnaHRz5oyJ5bm05pyI5pel5YiG57uE5ZCO55qE5paw5pWw5o2uDQpieV9kYXRlIDwtIGdyb3VwX2J5KGZsaWdodHMsIHllYXIsIG1vbnRoLCBkYXkpDQojIOeUseatpOW+l+WIsOavj+S4gOWkqeeahOW5s+Wdh+W7tuivr+aXtumXtOOAgg0Kc3VtbWFyaXplKGJ5X2RhdGUsIGRlbGF5ID0gbWVhbihkZXBfZGVsYXksIG5hLnJtID0gVCkpDQoNCiMg5Lmf5Y+v5Lul55So566h6YGT5pON5L2c5YaZ5oiQDQpmbGlnaHRzICU+JQ0KICBncm91cF9ieSh5ZWFyLCBtb250aCwgZGF5KSAlPiUNCiAgc3VtbWFyaXplKGRlbGF5ID0gbWVhbihkZXBfZGVsYXksIG5hLnJtID0gVFJVRSkpDQoNCiMg5Lmf5Y+v5Lul6aKE5YWI5Y675o6J5a2Y5ZyoTkHvvIjoiKrnj63lj5bmtojvvInnmoTooYzvvIzlhpnmiJANCm5vdF9jYW5jZWxsZWQgPC0gZmxpZ2h0cyAlPiUNCiAgZmlsdGVyKCFpcy5uYShkZXBfZGVsYXkpLCAhaXMubmEoYXJyX2RlbGF5KSkNCg0Kbm90X2NhbmNlbGxlZCAlPiUNCiAgZ3JvdXBfYnkoeWVhciwgbW9udGgsIGRheSkgJT4lDQogIHN1bW1hcml6ZShkZWxheSA9IG1lYW4oZGVwX2RlbGF5KSkNCg0KIyDop4Llr5/lubPlnYfmraPlu7bor6/ml7bpl7QNCm5vdF9jYW5jZWxsZWQgJT4lDQogIGdyb3VwX2J5KHllYXIsIG1vbnRoLCBkYXkpICU+JQ0KICBzdW1tYXJpemUoZGVsYXlfcG9zID0gbWVhbihkZXBfZGVsYXlbZGVwX2RlbGF5ID4gMF0pKQ0KYGBgDQoNCuS+izIg5oyJ55uu55qE5Zyw5YiG57uE77yM5oyJ55uu55qE5Zyw5YiG57uE77yM56CU56m25bmz5Z2H6aOe6KGM6Led56a75LiO5bmz5Z2H5bu26K+v5pe26Ze05LmL6Ze055qE5YWz57O7DQpgYGB7ciBleGFtcGxlMn0NCiMg5qC55o2u55uu55qE5Zyw5YiG57uEDQpieV9kZXN0IDwtIGdyb3VwX2J5KGZsaWdodHMsIGRlc3QpDQoNCiMg55SobWVhbigp57uf6K6h5bmz5Z2H6aOe6KGM6Led56a75ZKM5bmz5Z2H5bu26K+v5pe26Ze0DQojIOeUqG4oKee7n+iuoeiIquePreaVsO+8jHN1bSghaXNfbmEoKSnpnZ7nvLrlpLHlgLzorrDmlbANCnN1bV9kYXRhIDwtIHN1bW1hcml6ZShieV9kZXN0LA0KICBjb3VudCA9IG4oKSwNCiAgZGlzdCA9IG1lYW4oZGlzdGFuY2UsIG5hLnJtID0gVFJVRSksDQogIGRlbGF5ID0gbWVhbihhcnJfZGVsYXksIG5hLnJtID0gVFJVRSkNCikNCg0KIyDnrZvpgInlh7roiKrnj63mlbDlpKfkuo4yMO+8iOWOu+mZpOWwj+agt+acrO+8ieS4lOebrueahOWcsOS4jeS4uidITkwn55qE6KGMDQojIEhOTOi/meS4quacuuWcuuWcqOWkj+WogeWkt++8jOi3neemu+Wkqui/nOWxnuS6juW8guW4uOWAvA0KZGVsYXkgPC0gZmlsdGVyKHN1bV9kYXRhLCBjb3VudCA+IDI5LCBkZXN0ICE9ICJITkwiKQ0KDQojIOS9nOWbvg0KZ2dwbG90KGRhdGEgPSBkZWxheSwgbWFwcGluZyA9IGFlcyh4ID0gZGlzdCwgeSA9IGRlbGF5KSkgKw0KICBnZW9tX3BvaW50KGFlcyhzaXplID0gY291bnQpLCBhbHBoYSA9IDEgLyAzKSArDQogIGdlb21fc21vb3RoKHNlID0gRkFMU0UpDQoNCg0KIyDnrqHpgZPmk43kvZwNCiMg6L+Z5qC35YaZ5Luj56CB5b6I5riF5pmw77yM5q+P5LiA6KGM5piv5LiA5q2l5pON5L2cDQpmbGlnaHRzICU+JQ0KICBncm91cF9ieShkZXN0KSAlPiUgIyDliIbnu4QNCiAgc3VtbWFyaXplKA0KICAgIGNvdW50ID0gbigpLCBkaXN0ID0gbWVhbihkaXN0YW5jZSwgbmEucm0gPSBUUlVFKSwNCiAgICBkZWxheSA9IG1lYW4oYXJyX2RlbGF5LCBuYS5ybSA9IFRSVUUpDQogICkgJT4lICMg57uf6K6hDQogIGZpbHRlcihjb3VudCA+IDI5LCBkZXN0ICE9ICJITkwiKSAlPiUgIyDnrZvpgInop4LmtYsNCiAgZ2dwbG90KG1hcHBpbmcgPSBhZXMoeCA9IGRpc3QsIHkgPSBkZWxheSkpICsNCiAgZ2VvbV9wb2ludChhZXMoc2l6ZSA9IGNvdW50KSwgYWxwaGEgPSAxIC8gMykgKw0KICBnZW9tX3Ntb290aChzZSA9IEZBTFNFKSAjIOS9nOWbvg0KYGBgDQrlj6/op4HvvIw3NTDoi7Hph4zlhoXvvIzlubPlnYflu7bor6/ml7bpl7TkvJrpmo/nnYDot53nprvnmoTlop7liqDogIzlop7liqDvvIzmjqXnnYDkvJrpmo/nnYDot53nprvnmoTlop7liqDogIzlh4/lsJHjgILmiJborrjvvIzpmo/nnYDpo57ooYzot53nprvnmoTlop7liqDvvIzlu7bor6/ml7bpl7TmnInlj6/og73kvJrlnKjpo57ooYzkuK3lvKXooaXlm57mnaXjgIINCg0K5L6LMyDmn6XnnIvlhbfmnInmnIDplb/lubPlnYflu7bor6/ml7bpl7TnmoToiKrnj60NCmBgYHtyIGV4YW1wbGUzLTEsIGRlcGVuZHNvbj0nZXhhbXBsZTEnfQ0KIyDpgJrov4flsL7lj7fvvIh0YWlsbnVt77yJ5a+56Iiq54+t6L+b6KGM5YiG57uE6K+G5YirDQpub3RfY2FuY2VsbGVkICU+JQ0KICBncm91cF9ieSh0YWlsbnVtKSAlPiUNCiAgc3VtbWFyaXplKGRlbGF5ID0gbWVhbihhcnJfZGVsYXkpKSAlPiUNCiAgZ2dwbG90KG1hcHBpbmcgPSBhZXMoeCA9IGRlbGF5KSkgKw0KICBnZW9tX2ZyZXFwb2x5KGJpbndpZHRoID0gMTApDQpgYGANCuacieS6m+iIquePreeahOW5s+Wdh+W7tuivr+aXtumXtOmVv+i+vjMwMOWIhumSn++8jOi/meaYr+aAjuS5iOWbnuS6i+WRou+8nw0KDQpgYGB7ciBleGFtcGxlMy0yLCBkZXBlbmRzb249J2V4YW1wbGUxJ30NCiMg5L2c6Iiq54+t5p625qyh5pWw6YeP5ZKM5bmz5Z2H5bu26K+v5pe26Ze055qE5pWj54K55Zu+DQpub3RfY2FuY2VsbGVkICU+JQ0KICBncm91cF9ieSh0YWlsbnVtKSAlPiUNCiAgc3VtbWFyaXplKGRlbGF5ID0gbWVhbihhcnJfZGVsYXkpLCBuID0gbigpKSAlPiUNCiAgZ2dwbG90KG1hcHBpbmcgPSBhZXMoeCA9IG4sIHkgPSBkZWxheSkpICsNCiAgZ2VvbV9wb2ludChhbHBoYSA9IDAuMSkNCmBgYA0K55Sx5Zu+5Y+v6KeB77yM5b2T6Iiq54+t5pWw6YeP6Z2e5bi45bCR5pe277yM5bmz5Z2H5bu26K+v5pe26Ze055qE5Y+Y5Yqo54m55Yir5aSn44CCDQoNCuazqO+8mui/meW8oOWbvueahOW9oueKtumdnuW4uOiDveWkn+ivtOaYjumXrumimO+8muW9k+e7mOWItuWdh+WAvO+8iOaIluWFtuS7luaRmOimgee7n+iuoemHj++8ieWSjOWIhue7hOinhOaooeeahOWFs+ezu+aXtu+8jOaAu+iDveeci+WIsOmaj+edgOagt+acrOmHj+eahOWinuWKoO+8jOWPmOWKqOWcqOS4jeaWreWHj+Wwj+OAguWboOatpO+8jOafpeeci+atpOexu+WbvuW9ouaXtu+8jCoq6YCa5bi45bqU6K+l562b6YCJ5o6J6YKj5Lqb6KeC5rWL5pWw6YeP6Z2e5bi45bCR55qE5YiG57uE77yM6L+Z5qC35bCx5Y+v5Lul6YG/5YWN5Y+X5Yiw54m55Yir5bCP55qE5YiG57uE5Lit55qE5p6B56uv5Y+Y5Yqo55qE5b2x5ZON77yM6L+b6ICM5pu05aW95Zyw5Y+R546w5pWw5o2u5qih5byPKirjgIINCg0KYGBge3IgZXhhbXBsZTMtMywgZGVwZW5kc29uPSdleGFtcGxlMSd9DQojIOS9nOWOu+aOieWwj+agt+acrOWQju+8jOiIquePreaetuasoeaVsOmHj+WSjOW5s+Wdh+W7tuivr+aXtumXtOeahOaVo+eCueWbvg0Kbm90X2NhbmNlbGxlZCAlPiUNCiAgZ3JvdXBfYnkodGFpbG51bSkgJT4lDQogIHN1bW1hcml6ZShkZWxheSA9IG1lYW4oYXJyX2RlbGF5KSwgbiA9IG4oKSkgJT4lDQogIGZpbHRlcihuID49IDMwKSAlPiUNCiAgZ2dwbG90KG1hcHBpbmcgPSBhZXMoeCA9IG4sIHkgPSBkZWxheSkpICsNCiAgZ2VvbV9wb2ludChhbHBoYSA9IDAuMSkgKw0KICBnZW9tX3Ntb290aChtZXRob2QgPSAibG0iLCBzZSA9IEZBTFNFKQ0KYGBgDQrov5nml7bmiJHku6zlj5HnjrDvvIzlubPlnYflu7bor6/ml7bpl7TlpKflpJrlnKgyMOWIhumSn+S7peS4i++8m+mjnuihjOaetuasoeWcqDMw5Lul5LiK55qE6Iiq54+t77yM5bmz5Z2H5bu26K+v5pe26Ze05pyA6ZW/55qE5Lmf5Y+q5pyJNjDliIbpkp/jgIINCg0KDQrkvos0IOajkueQg+WHu+eQg+aJi+eahOWuieaJk+eOh+S4juWHu+eQg+asoeaVsOS5i+mXtOeahOWFs+ezu++8iOiDveWKm+S4juWHuuWcuuacuuS8mueahOWFs+ezu++8iQ0KYGBge3IgZXhhbXBsZTR9DQojIOajkueQg+avlOi1m+aVsOaNru+8jOi9rOaNouaIkHRpYmJsZeS9v+i+k+WHuuabtOe+juingg0KYmF0dGluZyA8LSBhc190aWJibGUoTGFobWFuOjpCYXR0aW5nKQ0KDQojIOagueaNrueQg+WRmElE5YiG57uE57uf6K6h77yM5oC75Ye75omT5pWwYWLlkozlronmiZPnjodiYe+8iOWuieaJk+aVsC/lh7vmiZPmlbDvvIkNCiMg5YiG57uE57uf6K6h5ZCO5YyF5ZCrcGxheWVySUQsIGFiLCBiYeWPmOmHj+eahOaWsOaVsOaNruahhuS4umJhdHRlcnMNCmJhdHRlcnMgPC0gYmF0dGluZyAlPiUNCiAgZ3JvdXBfYnkocGxheWVySUQpICU+JQ0KICBzdW1tYXJpemUoDQogICAgYmEgPSBzdW0oSCwgbmEucm0gPSBUUlVFKSAvIHN1bShBQiwgbmEucm0gPSBUUlVFKSwNCiAgICBhYiA9IHN1bShBQiwgbmEucm0gPSBUUlVFKQ0KICApDQoNCiMg5oyJ5a6J5omT546H5o6S5ZCN77yM5Y+R546w5L2N5qyh5pyA6Z2g5YmN55qE5piv5LiA5Lqb5oC75Ye75omT5pWw5Yeg5LmO5Li66Zu244CBDQojIOmdoOWlvei/kOawlOiOt+W+l+aegemrmOWuieaJk+eOh+eahOeQg+WRmOKAlOKAlOiAjOi/meW5tuS4jeihqOaYjuiDveWKm+W8uuOAgg0KYmF0dGVycyAlPiUgYXJyYW5nZShkZXNjKGJhKSkNCmJhdHRlcnMgJT4lIGdncGxvdChtYXBwaW5nID0gYWVzKHggPSBhYiwgeSA9IGJhKSkgKw0KICBnZW9tX3BvaW50KGFscGhhID0gMC4xKQ0KDQojIOW/veeVpeWwj+agt+acrO+8jOe7mOWItuWuieaJk+eOh37lh7vmiZPmlbDmlaPngrnlm77vvIzlj5HnjrDlronmiZPnjofln7rmnKzlsI/kuo4zNSUNCiMg5q2j55u45YWz5YWz57O777yM6K+05piO5a6J5omT546H6L6D6auY55qE55CD5ZGY5Ye75omT5pWw6L6D5aSa77yI5Ye65Zy65py65Lya5aSa77yJDQojIOeUseWbvuWPr+inge+8jOaLpeaciTIwJeS7peS4iueahOWuieaJk+eOh++8jOaJjeacieacuuS8muaIkOS4uueQg+mYn+S4u+WKmw0KYmF0dGVycyAlPiUNCiAgZmlsdGVyKGFiID4gMTAwKSAlPiUNCiAgZ2dwbG90KG1hcHBpbmcgPSBhZXMoeCA9IGFiLCB5ID0gYmEpKSArDQogIGdlb21fcG9pbnQoYWxwaGEgPSAwLjEpICsNCiAgZ2VvbV9zbW9vdGgoc2UgPSBGQUxTRSkNCmBgYA0KDQpgYGB7ciBvdGhlcjEsIGRlcGVuZHNvbj0nZXhhbXBsZTEnfQ0KIyDku45OLlku5Yiw5YW25LuW5py65Zy66aOe6KGM6Led56a755qE5qCH5YeG5beuDQpub3RfY2FuY2VsbGVkICU+JQ0KICBncm91cF9ieShkZXN0KSAlPiUNCiAgc3VtbWFyaXplKGRpc3RhbmNlX3NkID0gc2QoZGlzdGFuY2UpKSAlPiUNCiAgYXJyYW5nZShkZXNjKGRpc3RhbmNlX3NkKSkNCmBgYA0KDQpgYGB7ciBvdGhlcjIsIGRlcGVuZHNvbj0nZXhhbXBsZTEnfQ0KIyDmr4/lpKnmnIDml6nlkozmnIDmmZroiKrnj63nmoTlh7rlj5Hml7bpl7QNCm5vdF9jYW5jZWxsZWQgJT4lDQogIGdyb3VwX2J5KHllYXIsIG1vbnRoLCBkYXkpICU+JQ0KICBzdW1tYXJpemUoZmlyc3QgPSBtaW4oZGVwX3RpbWUpLCBsYXN0ID0gbWF4KGRlcF90aW1lKSkNCg0KIyDmib7lh7rmr4/lpKnmnIDml6nlkozmnIDmmZrlh7rlj5HnmoToiKrnj60NCiMgbWluX3JhbmsoeCnlj6/ku6Xov5Tlm57kuIDkuKrluo/liJflkITlhYPntKDnmoTljYfluo/kvY3nva7lkJHph48NCiMgbWluX3JhbmsoZGVzYyh4KSnov5Tlm57pmY3luo/kvY3nva7lkJHph48NCiMg5a+55Ye65Y+R5pe26Ze05o6S5bqP5ZCO77yM55SocmFuZ2UoKeWPluWHuuacgOWkp+WAvOWSjOacgOWwj+WAvA0KIyDlho3nlKhmaWx0ZXIoKeWPluWHuuavj+WkqeWHuuWPkeacgOaXqeWSjOacgOaZmueahOiIquePrQ0Kbm90X2NhbmNlbGxlZCAlPiUNCiAgZ3JvdXBfYnkoeWVhciwgbW9udGgsIGRheSkgJT4lDQogIG11dGF0ZShyID0gbWluX3JhbmsoZGVzYyhkZXBfdGltZSkpKSAlPiUNCiAgZmlsdGVyKHIgJWluJSByYW5nZShyKSkNCmBgYA0KDQpgYGB7ciBvdGhlcjQsIGRlcGVuZHNvbj0nZXhhbXBsZTEnfQ0KIyDnur3nuqboh7Plk6rkuKrnm67nmoTlnLDnmoToiKrnur/mnInmnIDlpJrnmoToiKrnqbrlhazlj7jov5DokKUNCiMgbl9kaXN0aW5jdCgp5Ye95pWw57uf6K6h5ZSv5LiA5YC855qE5pWw6YePDQpub3RfY2FuY2VsbGVkICU+JQ0KICBncm91cF9ieShkZXN0KSAlPiUNCiAgc3VtbWFyaXplKGNhcnJpZXJzID0gbl9kaXN0aW5jdChjYXJyaWVyKSkgJT4lDQogIGFycmFuZ2UoZGVzYyhjYXJyaWVycykpDQoNCiMg57q957qm5Ye65Y+R55qE5q+P5p2h6Iiq57q/5pyJ5aSa5bCR5Liq6Iiq54+tDQpub3RfY2FuY2VsbGVkICU+JSBjb3VudChkZXN0KQ0KDQojIOWKoOadg+iusOaVsO+8jOiuoeeul+avj+S4quiIquePreeahOaAu+mjnuihjOi3neemuw0Kbm90X2NhbmNlbGxlZCAlPiUgY291bnQodGFpbG51bSwgd3QgPSBkaXN0YW5jZSkNCmBgYA0KDQpgYGB7ciBvdGhlcjUsIGRlcGVuZHNvbj0nZXhhbXBsZTEnfQ0KIyDoi6V45Li66YC76L6R5ZCR6YeP77yMc3VtKHgp5Y+v5Lul5om+5Ye6eOS4rVRSVUXnmoTmlbDph4/vvIxtZWFuKHgp5Y+v5Lul5om+5Ye6eOS4rVRSVUXnmoTmr5TkvovjgIINCiMg5q+P5aSp5pyJ5aSa5bCR5p626Iiq54+t5piv5pep5LiKNeeCueWJjeWHuuWPkeeahA0Kbm90X2NhbmNlbGxlZCAlPiUNCiAgZ3JvdXBfYnkoeWVhciwgbW9udGgsIGRheSkgJT4lDQogIHN1bW1hcml6ZShuX2Vhcmx5ID0gc3VtKGRlcF90aW1lIDwgNTAwKSkNCg0KIyDlu7bor6/otoXov4cx5bCP5pe255qE6Iiq54+t5q+U5L6L5piv5aSa5bCRDQpub3RfY2FuY2VsbGVkICU+JQ0KICBncm91cF9ieSh5ZWFyLCBtb250aCwgZGF5KSAlPiUNCiAgc3VtbWFyaXplKGhvdXJfcGVyYyA9IG1lYW4oYXJyX2RlbGF5ID4gNjApKQ0KYGBgDQo=