purrr教程2

Dongbei University of Finance & Economics

1 加载经常用的R包

library(pacman)
# 读数据
p_load(readxl,writexl,data.table,openxlsx,haven,rvest)

# 数据探索
p_load(tidyverse,DT,skimr,DataExplorer,explore,vtable,stringr,kableExtra,lubridate)

# 模型
p_load(grf,glmnet,caret,tidytext,fpp2,forecast,car,tseries,hdm,tidymodels,broom)

# 可视化
p_load(patchwork,ggrepel,ggcorrplot,gghighlight,ggthemes,shiny)

# 其它常用包
p_load(magrittr,listviewer,devtools,here,janitor,reticulate,jsonlite)

p_load(repurrrsive,stringi)

2 介绍repurrrsive

repurrrsive::sw_people %>% listviewer::jsonedit()

sw_people %>% head(2)

## [[1]]
## [[1]]$name
## [1] "Luke Skywalker"
## 
## [[1]]$height
## [1] "172"
## 
## [[1]]$mass
## [1] "77"
## 
## [[1]]$hair_color
## [1] "blond"
## 
## [[1]]$skin_color
## [1] "fair"
## 
## [[1]]$eye_color
## [1] "blue"
## 
## [[1]]$birth_year
## [1] "19BBY"
## 
## [[1]]$gender
## [1] "male"
## 
## [[1]]$homeworld
## [1] "http://swapi.co/api/planets/1/"
## 
## [[1]]$films
## [1] "http://swapi.co/api/films/6/" "http://swapi.co/api/films/3/"
## [3] "http://swapi.co/api/films/2/" "http://swapi.co/api/films/1/"
## [5] "http://swapi.co/api/films/7/"
## 
## [[1]]$species
## [1] "http://swapi.co/api/species/1/"
## 
## [[1]]$vehicles
## [1] "http://swapi.co/api/vehicles/14/" "http://swapi.co/api/vehicles/30/"
## 
## [[1]]$starships
## [1] "http://swapi.co/api/starships/12/" "http://swapi.co/api/starships/22/"
## 
## [[1]]$created
## [1] "2014-12-09T13:50:51.644000Z"
## 
## [[1]]$edited
## [1] "2014-12-20T21:17:56.891000Z"
## 
## [[1]]$url
## [1] "http://swapi.co/api/people/1/"
## 
## 
## [[2]]
## [[2]]$name
## [1] "C-3PO"
## 
## [[2]]$height
## [1] "167"
## 
## [[2]]$mass
## [1] "75"
## 
## [[2]]$hair_color
## [1] "n/a"
## 
## [[2]]$skin_color
## [1] "gold"
## 
## [[2]]$eye_color
## [1] "yellow"
## 
## [[2]]$birth_year
## [1] "112BBY"
## 
## [[2]]$gender
## [1] "n/a"
## 
## [[2]]$homeworld
## [1] "http://swapi.co/api/planets/1/"
## 
## [[2]]$films
## [1] "http://swapi.co/api/films/5/" "http://swapi.co/api/films/4/"
## [3] "http://swapi.co/api/films/6/" "http://swapi.co/api/films/3/"
## [5] "http://swapi.co/api/films/2/" "http://swapi.co/api/films/1/"
## 
## [[2]]$species
## [1] "http://swapi.co/api/species/2/"
## 
## [[2]]$created
## [1] "2014-12-10T15:10:51.357000Z"
## 
## [[2]]$edited
## [1] "2014-12-20T21:17:50.309000Z"
## 
## [[2]]$url
## [1] "http://swapi.co/api/people/2/"

sw_people[[1]] 

## $name
## [1] "Luke Skywalker"
## 
## $height
## [1] "172"
## 
## $mass
## [1] "77"
## 
## $hair_color
## [1] "blond"
## 
## $skin_color
## [1] "fair"
## 
## $eye_color
## [1] "blue"
## 
## $birth_year
## [1] "19BBY"
## 
## $gender
## [1] "male"
## 
## $homeworld
## [1] "http://swapi.co/api/planets/1/"
## 
## $films
## [1] "http://swapi.co/api/films/6/" "http://swapi.co/api/films/3/"
## [3] "http://swapi.co/api/films/2/" "http://swapi.co/api/films/1/"
## [5] "http://swapi.co/api/films/7/"
## 
## $species
## [1] "http://swapi.co/api/species/1/"
## 
## $vehicles
## [1] "http://swapi.co/api/vehicles/14/" "http://swapi.co/api/vehicles/30/"
## 
## $starships
## [1] "http://swapi.co/api/starships/12/" "http://swapi.co/api/starships/22/"
## 
## $created
## [1] "2014-12-09T13:50:51.644000Z"
## 
## $edited
## [1] "2014-12-20T21:17:56.891000Z"
## 
## $url
## [1] "http://swapi.co/api/people/1/"

sw_people[[1]] %>% listviewer::jsonedit()

How many elements are in sw_people?

sw_people %>% length()

## [1] 87

Who is the first person listed in sw_people? What information is given for this person?

sw_people %>% .[[1]]

## $name
## [1] "Luke Skywalker"
## 
## $height
## [1] "172"
## 
## $mass
## [1] "77"
## 
## $hair_color
## [1] "blond"
## 
## $skin_color
## [1] "fair"
## 
## $eye_color
## [1] "blue"
## 
## $birth_year
## [1] "19BBY"
## 
## $gender
## [1] "male"
## 
## $homeworld
## [1] "http://swapi.co/api/planets/1/"
## 
## $films
## [1] "http://swapi.co/api/films/6/" "http://swapi.co/api/films/3/"
## [3] "http://swapi.co/api/films/2/" "http://swapi.co/api/films/1/"
## [5] "http://swapi.co/api/films/7/"
## 
## $species
## [1] "http://swapi.co/api/species/1/"
## 
## $vehicles
## [1] "http://swapi.co/api/vehicles/14/" "http://swapi.co/api/vehicles/30/"
## 
## $starships
## [1] "http://swapi.co/api/starships/12/" "http://swapi.co/api/starships/22/"
## 
## $created
## [1] "2014-12-09T13:50:51.644000Z"
## 
## $edited
## [1] "2014-12-20T21:17:56.891000Z"
## 
## $url
## [1] "http://swapi.co/api/people/1/"

What is the difference between sw_people[1] and sw_people[[1]]?

sw_people %>% .[1]

## [[1]]
## [[1]]$name
## [1] "Luke Skywalker"
## 
## [[1]]$height
## [1] "172"
## 
## [[1]]$mass
## [1] "77"
## 
## [[1]]$hair_color
## [1] "blond"
## 
## [[1]]$skin_color
## [1] "fair"
## 
## [[1]]$eye_color
## [1] "blue"
## 
## [[1]]$birth_year
## [1] "19BBY"
## 
## [[1]]$gender
## [1] "male"
## 
## [[1]]$homeworld
## [1] "http://swapi.co/api/planets/1/"
## 
## [[1]]$films
## [1] "http://swapi.co/api/films/6/" "http://swapi.co/api/films/3/"
## [3] "http://swapi.co/api/films/2/" "http://swapi.co/api/films/1/"
## [5] "http://swapi.co/api/films/7/"
## 
## [[1]]$species
## [1] "http://swapi.co/api/species/1/"
## 
## [[1]]$vehicles
## [1] "http://swapi.co/api/vehicles/14/" "http://swapi.co/api/vehicles/30/"
## 
## [[1]]$starships
## [1] "http://swapi.co/api/starships/12/" "http://swapi.co/api/starships/22/"
## 
## [[1]]$created
## [1] "2014-12-09T13:50:51.644000Z"
## 
## [[1]]$edited
## [1] "2014-12-20T21:17:56.891000Z"
## 
## [[1]]$url
## [1] "http://swapi.co/api/people/1/"

sw_people %>% .[[1]]

## $name
## [1] "Luke Skywalker"
## 
## $height
## [1] "172"
## 
## $mass
## [1] "77"
## 
## $hair_color
## [1] "blond"
## 
## $skin_color
## [1] "fair"
## 
## $eye_color
## [1] "blue"
## 
## $birth_year
## [1] "19BBY"
## 
## $gender
## [1] "male"
## 
## $homeworld
## [1] "http://swapi.co/api/planets/1/"
## 
## $films
## [1] "http://swapi.co/api/films/6/" "http://swapi.co/api/films/3/"
## [3] "http://swapi.co/api/films/2/" "http://swapi.co/api/films/1/"
## [5] "http://swapi.co/api/films/7/"
## 
## $species
## [1] "http://swapi.co/api/species/1/"
## 
## $vehicles
## [1] "http://swapi.co/api/vehicles/14/" "http://swapi.co/api/vehicles/30/"
## 
## $starships
## [1] "http://swapi.co/api/starships/12/" "http://swapi.co/api/starships/22/"
## 
## $created
## [1] "2014-12-09T13:50:51.644000Z"
## 
## $edited
## [1] "2014-12-20T21:17:56.891000Z"
## 
## $url
## [1] "http://swapi.co/api/people/1/"

3 map(.x,.f,…)函数

luck <- sw_people[[1]]
luck

## $name
## [1] "Luke Skywalker"
## 
## $height
## [1] "172"
## 
## $mass
## [1] "77"
## 
## $hair_color
## [1] "blond"
## 
## $skin_color
## [1] "fair"
## 
## $eye_color
## [1] "blue"
## 
## $birth_year
## [1] "19BBY"
## 
## $gender
## [1] "male"
## 
## $homeworld
## [1] "http://swapi.co/api/planets/1/"
## 
## $films
## [1] "http://swapi.co/api/films/6/" "http://swapi.co/api/films/3/"
## [3] "http://swapi.co/api/films/2/" "http://swapi.co/api/films/1/"
## [5] "http://swapi.co/api/films/7/"
## 
## $species
## [1] "http://swapi.co/api/species/1/"
## 
## $vehicles
## [1] "http://swapi.co/api/vehicles/14/" "http://swapi.co/api/vehicles/30/"
## 
## $starships
## [1] "http://swapi.co/api/starships/12/" "http://swapi.co/api/starships/22/"
## 
## $created
## [1] "2014-12-09T13:50:51.644000Z"
## 
## $edited
## [1] "2014-12-20T21:17:56.891000Z"
## 
## $url
## [1] "http://swapi.co/api/people/1/"

luck$starships %>% length()

## [1] 2

leia <- sw_people[[5]]
leia

## $name
## [1] "Leia Organa"
## 
## $height
## [1] "150"
## 
## $mass
## [1] "49"
## 
## $hair_color
## [1] "brown"
## 
## $skin_color
## [1] "light"
## 
## $eye_color
## [1] "brown"
## 
## $birth_year
## [1] "19BBY"
## 
## $gender
## [1] "female"
## 
## $homeworld
## [1] "http://swapi.co/api/planets/2/"
## 
## $films
## [1] "http://swapi.co/api/films/6/" "http://swapi.co/api/films/3/"
## [3] "http://swapi.co/api/films/2/" "http://swapi.co/api/films/1/"
## [5] "http://swapi.co/api/films/7/"
## 
## $species
## [1] "http://swapi.co/api/species/1/"
## 
## $vehicles
## [1] "http://swapi.co/api/vehicles/30/"
## 
## $created
## [1] "2014-12-10T15:20:09.791000Z"
## 
## $edited
## [1] "2014-12-20T21:17:50.315000Z"
## 
## $url
## [1] "http://swapi.co/api/people/5/"

leia$starships %>% length()

## [1] 0

map(sw_people,function(i){
  i$starships %>% length()
}) %>% unlist()

##  [1] 2 0 0 1 0 0 0 0 1 5 3 0 2 2 0 0 1 1 0 0 1 0 0 1 0 0 0 1 0 1 0 0 0 0 0 0 1 0
## [39] 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 1 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [77] 1 0 0 0 0 0 0 1 0 0 3

map(sw_people,function(i){
  i[["hair_color"]]
}) %>% unlist()

##  [1] "blond"         "n/a"           "n/a"           "none"         
##  [5] "brown"         "brown, grey"   "brown"         "n/a"          
##  [9] "black"         "auburn, white" "blond"         "auburn, grey" 
## [13] "brown"         "brown"         "n/a"           "n/a"          
## [17] "brown"         "brown"         "white"         "grey"         
## [21] "black"         "none"          "none"          "black"        
## [25] "none"          "none"          "auburn"        "brown"        
## [29] "brown"         "none"          "brown"         "none"         
## [33] "blond"         "none"          "none"          "none"         
## [37] "brown"         "black"         "none"          "black"        
## [41] "black"         "none"          "none"          "none"         
## [45] "none"          "none"          "none"          "none"         
## [49] "white"         "none"          "black"         "none"         
## [53] "none"          "none"          "none"          "none"         
## [57] "black"         "brown"         "brown"         "none"         
## [61] "black"         "black"         "brown"         "white"        
## [65] "black"         "black"         "blonde"        "none"         
## [69] "none"          "none"          "white"         "none"         
## [73] "none"          "none"          "none"          "none"         
## [77] "none"          "brown"         "brown"         "none"         
## [81] "none"          "black"         "brown"         "brown"        
## [85] "none"          "unknown"       "brown"

map(sw_people, "starships") -> x
map(sw_people,function(i){
  i[["starships"]]
}) -> y
all.equal(x,y)

## [1] TRUE

为什么要用purrr,而不是apply家族

• consistent return type
• useful shortcuts
• consistent syntax for more complicated iteration

4 轮到你了-sw_*数据集

Which film (see sw_films) has the most characters?

sw_films %>% listviewer::jsonedit()

sw_films %>% length()

## [1] 7

sw_films %>% .[1]

## [[1]]
## [[1]]$title
## [1] "A New Hope"
## 
## [[1]]$episode_id
## [1] 4
## 
## [[1]]$opening_crawl
## [1] "It is a period of civil war.\r\nRebel spaceships, striking\r\nfrom a hidden base, have won\r\ntheir first victory against\r\nthe evil Galactic Empire.\r\n\r\nDuring the battle, Rebel\r\nspies managed to steal secret\r\nplans to the Empire's\r\nultimate weapon, the DEATH\r\nSTAR, an armored space\r\nstation with enough power\r\nto destroy an entire planet.\r\n\r\nPursued by the Empire's\r\nsinister agents, Princess\r\nLeia races home aboard her\r\nstarship, custodian of the\r\nstolen plans that can save her\r\npeople and restore\r\nfreedom to the galaxy...."
## 
## [[1]]$director
## [1] "George Lucas"
## 
## [[1]]$producer
## [1] "Gary Kurtz, Rick McCallum"
## 
## [[1]]$release_date
## [1] "1977-05-25"
## 
## [[1]]$characters
##  [1] "http://swapi.co/api/people/1/"  "http://swapi.co/api/people/2/" 
##  [3] "http://swapi.co/api/people/3/"  "http://swapi.co/api/people/4/" 
##  [5] "http://swapi.co/api/people/5/"  "http://swapi.co/api/people/6/" 
##  [7] "http://swapi.co/api/people/7/"  "http://swapi.co/api/people/8/" 
##  [9] "http://swapi.co/api/people/9/"  "http://swapi.co/api/people/10/"
## [11] "http://swapi.co/api/people/12/" "http://swapi.co/api/people/13/"
## [13] "http://swapi.co/api/people/14/" "http://swapi.co/api/people/15/"
## [15] "http://swapi.co/api/people/16/" "http://swapi.co/api/people/18/"
## [17] "http://swapi.co/api/people/19/" "http://swapi.co/api/people/81/"
## 
## [[1]]$planets
## [1] "http://swapi.co/api/planets/2/" "http://swapi.co/api/planets/3/"
## [3] "http://swapi.co/api/planets/1/"
## 
## [[1]]$starships
## [1] "http://swapi.co/api/starships/2/"  "http://swapi.co/api/starships/3/" 
## [3] "http://swapi.co/api/starships/5/"  "http://swapi.co/api/starships/9/" 
## [5] "http://swapi.co/api/starships/10/" "http://swapi.co/api/starships/11/"
## [7] "http://swapi.co/api/starships/12/" "http://swapi.co/api/starships/13/"
## 
## [[1]]$vehicles
## [1] "http://swapi.co/api/vehicles/4/" "http://swapi.co/api/vehicles/6/"
## [3] "http://swapi.co/api/vehicles/7/" "http://swapi.co/api/vehicles/8/"
## 
## [[1]]$species
## [1] "http://swapi.co/api/species/5/" "http://swapi.co/api/species/3/"
## [3] "http://swapi.co/api/species/2/" "http://swapi.co/api/species/1/"
## [5] "http://swapi.co/api/species/4/"
## 
## [[1]]$created
## [1] "2014-12-10T14:23:31.880000Z"
## 
## [[1]]$edited
## [1] "2015-04-11T09:46:52.774897Z"
## 
## [[1]]$url
## [1] "http://swapi.co/api/films/1/"

sw_films %>% .[[1]]

## $title
## [1] "A New Hope"
## 
## $episode_id
## [1] 4
## 
## $opening_crawl
## [1] "It is a period of civil war.\r\nRebel spaceships, striking\r\nfrom a hidden base, have won\r\ntheir first victory against\r\nthe evil Galactic Empire.\r\n\r\nDuring the battle, Rebel\r\nspies managed to steal secret\r\nplans to the Empire's\r\nultimate weapon, the DEATH\r\nSTAR, an armored space\r\nstation with enough power\r\nto destroy an entire planet.\r\n\r\nPursued by the Empire's\r\nsinister agents, Princess\r\nLeia races home aboard her\r\nstarship, custodian of the\r\nstolen plans that can save her\r\npeople and restore\r\nfreedom to the galaxy...."
## 
## $director
## [1] "George Lucas"
## 
## $producer
## [1] "Gary Kurtz, Rick McCallum"
## 
## $release_date
## [1] "1977-05-25"
## 
## $characters
##  [1] "http://swapi.co/api/people/1/"  "http://swapi.co/api/people/2/" 
##  [3] "http://swapi.co/api/people/3/"  "http://swapi.co/api/people/4/" 
##  [5] "http://swapi.co/api/people/5/"  "http://swapi.co/api/people/6/" 
##  [7] "http://swapi.co/api/people/7/"  "http://swapi.co/api/people/8/" 
##  [9] "http://swapi.co/api/people/9/"  "http://swapi.co/api/people/10/"
## [11] "http://swapi.co/api/people/12/" "http://swapi.co/api/people/13/"
## [13] "http://swapi.co/api/people/14/" "http://swapi.co/api/people/15/"
## [15] "http://swapi.co/api/people/16/" "http://swapi.co/api/people/18/"
## [17] "http://swapi.co/api/people/19/" "http://swapi.co/api/people/81/"
## 
## $planets
## [1] "http://swapi.co/api/planets/2/" "http://swapi.co/api/planets/3/"
## [3] "http://swapi.co/api/planets/1/"
## 
## $starships
## [1] "http://swapi.co/api/starships/2/"  "http://swapi.co/api/starships/3/" 
## [3] "http://swapi.co/api/starships/5/"  "http://swapi.co/api/starships/9/" 
## [5] "http://swapi.co/api/starships/10/" "http://swapi.co/api/starships/11/"
## [7] "http://swapi.co/api/starships/12/" "http://swapi.co/api/starships/13/"
## 
## $vehicles
## [1] "http://swapi.co/api/vehicles/4/" "http://swapi.co/api/vehicles/6/"
## [3] "http://swapi.co/api/vehicles/7/" "http://swapi.co/api/vehicles/8/"
## 
## $species
## [1] "http://swapi.co/api/species/5/" "http://swapi.co/api/species/3/"
## [3] "http://swapi.co/api/species/2/" "http://swapi.co/api/species/1/"
## [5] "http://swapi.co/api/species/4/"
## 
## $created
## [1] "2014-12-10T14:23:31.880000Z"
## 
## $edited
## [1] "2015-04-11T09:46:52.774897Z"
## 
## $url
## [1] "http://swapi.co/api/films/1/"

sw_films %>% .[[1]] %>% .[[3]]

## [1] "It is a period of civil war.\r\nRebel spaceships, striking\r\nfrom a hidden base, have won\r\ntheir first victory against\r\nthe evil Galactic Empire.\r\n\r\nDuring the battle, Rebel\r\nspies managed to steal secret\r\nplans to the Empire's\r\nultimate weapon, the DEATH\r\nSTAR, an armored space\r\nstation with enough power\r\nto destroy an entire planet.\r\n\r\nPursued by the Empire's\r\nsinister agents, Princess\r\nLeia races home aboard her\r\nstarship, custodian of the\r\nstolen plans that can save her\r\npeople and restore\r\nfreedom to the galaxy...."

map(sw_films,function(i){
  i[["characters"]]
}) %>% 
  map(length) %>%
  unlist() %>% 
  set_names(
    map_chr(sw_films,function(i){
  i[["title"]]
})
  ) %>% 
  sort()

##       The Force Awakens The Empire Strikes Back              A New Hope 
##                      11                      16                      18 
##      Return of the Jedi      The Phantom Menace     Revenge of the Sith 
##                      20                      34                      34 
##    Attack of the Clones 
##                      40

sw_species %>% 
  map(function(i){
    i[["eye_colors"]]
  }) %>% unlist() %>% 
  str_split(pattern = ",") %>% 
  map(length) %>% unlist() %>% 
  set_names(1:37) %>% 
  sort()

##  4  6  8  9 12 13 14 15 16 17 20 21 23 26 27 28 29 30 32 33 35 37  1  3  5  7 
##  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  2  2  2  2 
## 10 18 19 22 24  2 11 25 31 34 36 
##  2  2  2  2  2  3  4  6  6  6  6

5 更多的迭代函数

• map(.x,.f,…)
• walk(.x,.f,…)
• map2(.x,.y,.f)

6 轮到你了-map or walk

1. For each function, which two arguments might be useful to iterate over?

• download.file()
• rnorm()
• lm()
• predict.lm()
• write.csv()

2. For which functions above should we use walk2() or a typed version of map2()?

gap_split_small <- gap_split[1:10]
countries <- names(gap_split_small)

ggplot(gap_split[[1]],aes(year,lifeExp)) +
  geom_line() +
  labs(title = countries[[1]]) +
  theme(text = element_text(family = enfont),
        plot.title = element_text(hjust = 0.5))

map2(gap_split_small,countries,function(i,j){
  ggplot(i,aes(year,lifeExp)) +
  geom_line() +
  labs(title = j) +
  theme(text = element_text(family = enfont),
        plot.title = element_text(hjust = 0.5))
}) -> plots

plots[[2]]
walk(plots,print) # this might take awhile

7 purrr和列表列

people_tbl <- tibble(
  name = sw_people %>% map_chr("name"),
  films = sw_people %>% map("films"),
  height = sw_people %>% map_chr("height") %>%
    readr::parse_number(na = "unknown"),
  species = sw_people %>% map_chr("species", .null = NA_character_
  )
)
people_tbl

8 purrr：pmap和invoke_map

• pmap
• invoke_map

9 WRAP UP!

purrr provides:

• functions that write for loops for you
• with consistent syntax
• convenient shortcuts for specifying functions to iterate

Choosing the right function depends on:

• type of iteration
• type of output

10 学习更多

Jenny Bryan’s purrr tutorial

https://github.com/jennybc/purrr-tutorial

All materials (code files too): https://github.com/cwickham/purrr-tutorial

11 练习1-mtcars

mtcars_by_cyl <- mtcars %>% 
  split(mtcars$cyl)
mtcars_by_cyl

## $`4`
##                 mpg cyl  disp  hp drat    wt  qsec vs am gear carb
## Datsun 710     22.8   4 108.0  93 3.85 2.320 18.61  1  1    4    1
## Merc 240D      24.4   4 146.7  62 3.69 3.190 20.00  1  0    4    2
## Merc 230       22.8   4 140.8  95 3.92 3.150 22.90  1  0    4    2
## Fiat 128       32.4   4  78.7  66 4.08 2.200 19.47  1  1    4    1
## Honda Civic    30.4   4  75.7  52 4.93 1.615 18.52  1  1    4    2
## Toyota Corolla 33.9   4  71.1  65 4.22 1.835 19.90  1  1    4    1
## Toyota Corona  21.5   4 120.1  97 3.70 2.465 20.01  1  0    3    1
## Fiat X1-9      27.3   4  79.0  66 4.08 1.935 18.90  1  1    4    1
## Porsche 914-2  26.0   4 120.3  91 4.43 2.140 16.70  0  1    5    2
## Lotus Europa   30.4   4  95.1 113 3.77 1.513 16.90  1  1    5    2
## Volvo 142E     21.4   4 121.0 109 4.11 2.780 18.60  1  1    4    2
## 
## $`6`
##                 mpg cyl  disp  hp drat    wt  qsec vs am gear carb
## Mazda RX4      21.0   6 160.0 110 3.90 2.620 16.46  0  1    4    4
## Mazda RX4 Wag  21.0   6 160.0 110 3.90 2.875 17.02  0  1    4    4
## Hornet 4 Drive 21.4   6 258.0 110 3.08 3.215 19.44  1  0    3    1
## Valiant        18.1   6 225.0 105 2.76 3.460 20.22  1  0    3    1
## Merc 280       19.2   6 167.6 123 3.92 3.440 18.30  1  0    4    4
## Merc 280C      17.8   6 167.6 123 3.92 3.440 18.90  1  0    4    4
## Ferrari Dino   19.7   6 145.0 175 3.62 2.770 15.50  0  1    5    6
## 
## $`8`
##                      mpg cyl  disp  hp drat    wt  qsec vs am gear carb
## Hornet Sportabout   18.7   8 360.0 175 3.15 3.440 17.02  0  0    3    2
## Duster 360          14.3   8 360.0 245 3.21 3.570 15.84  0  0    3    4
## Merc 450SE          16.4   8 275.8 180 3.07 4.070 17.40  0  0    3    3
## Merc 450SL          17.3   8 275.8 180 3.07 3.730 17.60  0  0    3    3
## Merc 450SLC         15.2   8 275.8 180 3.07 3.780 18.00  0  0    3    3
## Cadillac Fleetwood  10.4   8 472.0 205 2.93 5.250 17.98  0  0    3    4
## Lincoln Continental 10.4   8 460.0 215 3.00 5.424 17.82  0  0    3    4
## Chrysler Imperial   14.7   8 440.0 230 3.23 5.345 17.42  0  0    3    4
## Dodge Challenger    15.5   8 318.0 150 2.76 3.520 16.87  0  0    3    2
## AMC Javelin         15.2   8 304.0 150 3.15 3.435 17.30  0  0    3    2
## Camaro Z28          13.3   8 350.0 245 3.73 3.840 15.41  0  0    3    4
## Pontiac Firebird    19.2   8 400.0 175 3.08 3.845 17.05  0  0    3    2
## Ford Pantera L      15.8   8 351.0 264 4.22 3.170 14.50  0  1    5    4
## Maserati Bora       15.0   8 301.0 335 3.54 3.570 14.60  0  1    5    8

# Fit a regression model to each element 
map(mtcars_by_cyl,function(i){
  lm(mpg~disp,data = i)
})

## $`4`
## 
## Call:
## lm(formula = mpg ~ disp, data = i)
## 
## Coefficients:
## (Intercept)         disp  
##     40.8720      -0.1351  
## 
## 
## $`6`
## 
## Call:
## lm(formula = mpg ~ disp, data = i)
## 
## Coefficients:
## (Intercept)         disp  
##   19.081987     0.003605  
## 
## 
## $`8`
## 
## Call:
## lm(formula = mpg ~ disp, data = i)
## 
## Coefficients:
## (Intercept)         disp  
##    22.03280     -0.01963

library(broom)
# Extract R^2 from each regression model
map(mtcars_by_cyl,function(i){
  lm(mpg~disp,data = i)
}) %>% map(glance) %>% 
  map(function(i){i[["r.squared"]]})

## $`4`
## [1] 0.6484051
## 
## $`6`
## [1] 0.01062604
## 
## $`8`
## [1] 0.2701578

# Extract the slope from each regression model
# Extract R^2 from each regression model
map(mtcars_by_cyl,function(i){
  lm(mpg~disp,data = i)
}) %>% map(tidy) %>% 
  map(function(i){i[["estimate"]]}) %>% 
  bind_cols()

12 练习2-word_count.R

read_lines(file = "../data1/challenges/word_count_files/geospatial-README.md") -> geospatial_README_text

read_lines(file = "../data1/challenges/word_count_files/nass-README.md") -> nass_README_text

read_lines(file = "../data1/challenges/word_count_files/purrr-workshop-README.md") -> purrr_README_text

stri_stats_general(geospatial_README_text)

##       Lines LinesNEmpty       Chars CharsNWhite 
##          71          48        1485        1316

stri_stats_general(nass_README_text)

##       Lines LinesNEmpty       Chars CharsNWhite 
##          25          16        2025        1753

stri_stats_general(purrr_README_text)

##       Lines LinesNEmpty       Chars CharsNWhite 
##          13           8        1206         999