Tidyverse2

library(tidyverse)
library(DT)
library(lubridate)
library(stringr)
library(explore)

list.files()#查看当前文件夹下的文件

##  [1] "ARMA-templet.Rmd"                             
##  [2] "ARMA课程练习.Rmd"                             
##  [3] "bitcoin与gold.Rmd"                            
##  [4] "CHAP3arrange排列行.Rmd"                       
##  [5] "CHAP3filter筛选行.Rmd"                        
##  [6] "CHAP3select选择列mutate添加新变量.Rmd"        
##  [7] "CHAP3summarize分组摘要.Rmd"                   
##  [8] "DCCGARCH template.Rmd"                        
##  [9] "DCCGARCH.Rmd"                                 
## [10] "garch.Rmd"                                    
## [11] "garch试验.Rmd"                                
## [12] "ggplot2-学习之外观设置.Rmd"                   
## [13] "ggplot2(1).Rmd"                               
## [14] "ggplot2.Rmd"                                  
## [15] "IBM ARIMA.Rmd"                                
## [16] "Learning-notes-for-R-in-Action.html"          
## [17] "Learning-notes-for-R-in-Action.Rmd"           
## [18] "mtcars.xlsx"                                  
## [19] "Rmarkdown-template1.html"                     
## [20] "Rmarkdown-template2.html"                     
## [21] "Rmarkdown guide.Rmd"                          
## [22] "Rmarkdown template1.Rmd"                      
## [23] "Rmarkdown template2.Rmd"                      
## [24] "rsconnect"                                    
## [25] "R的金融应用第四章第三节.Rmd"                  
## [26] "R的金融应用第四章一二节.docx"                 
## [27] "R的金融应用第四章一二节.Rmd"                  
## [28] "template of ARIMA.Rmd"                        
## [29] "template1 of regression.Rmd"                  
## [30] "tidyverse-reading-and-writing.html"           
## [31] "tidyverse-reading-and-writing.Rmd"            
## [32] "tidyverse2.html"                              
## [33] "tidyverse2.Rmd"                               
## [34] "tvar的脉冲响应函数.txt"                       
## [35] "tvar脉冲函数模板.Rmd"                         
## [36] "univariate garch.Rmd"                         
## [37] "VAR课堂练习.Rmd"                              
## [38] "财务报表分析案例1.Rmd"                        
## [39] "代码.Rproj"                                   
## [40] "单笔时间序列性质.Rmd"                         
## [41] "第12周一元回归.Rmd"                           
## [42] "第九周.R"                                     
## [43] "第九周课2.R"                                  
## [44] "基于ARIMA模型的我国全社会固定资产投资预测.Rmd"
## [45] "金融时间序列第一章案例1.Rmd"                  
## [46] "数据科学第二轮CHAP3（2）.Rmd"                 
## [47] "统计练习.Rmd"                                 
## [48] "徐晴霏.R"                                     
## [49] "一元线性回归.Rmd"                             
## [50] "原油期货的TVAR模型.Rmd"                       
## [51] "作业.Rmd"

管道

例子

mtcars %>% 
  head()

mtcars %>% 
  colnames()

##  [1] "mpg"  "cyl"  "disp" "hp"   "drat" "wt"   "qsec" "vs"   "am"   "gear"
## [11] "carb"

mtcars %>% lm(mpg~cyl,data = .) 

## 
## Call:
## lm(formula = mpg ~ cyl, data = .)
## 
## Coefficients:
## (Intercept)          cyl  
##      37.885       -2.876

mtcars %>% str()

## 'data.frame':    32 obs. of  11 variables:
##  $ mpg : num  21 21 22.8 21.4 18.7 18.1 14.3 24.4 22.8 19.2 ...
##  $ cyl : num  6 6 4 6 8 6 8 4 4 6 ...
##  $ disp: num  160 160 108 258 360 ...
##  $ hp  : num  110 110 93 110 175 105 245 62 95 123 ...
##  $ drat: num  3.9 3.9 3.85 3.08 3.15 2.76 3.21 3.69 3.92 3.92 ...
##  $ wt  : num  2.62 2.88 2.32 3.21 3.44 ...
##  $ qsec: num  16.5 17 18.6 19.4 17 ...
##  $ vs  : num  0 0 1 1 0 1 0 1 1 1 ...
##  $ am  : num  1 1 1 0 0 0 0 0 0 0 ...
##  $ gear: num  4 4 4 3 3 3 3 4 4 4 ...
##  $ carb: num  4 4 1 1 2 1 4 2 2 4 ...

选择数据框的列(dplyr包)

select提取列

mtcars %>% datatable()

mtcars %>% select(mpg,hp,vs) %>% head()

mtcars %>% select(-am) %>% datatable()

mtcars %>% select(mpg:wt) %>% head()

mtcars %>% select(!cyl)

mtcars %>% select(starts_with("a"))

mtcars %>% select(ends_with("p"))

mtcars %>% select(contains("at"))

ggplot2movies::movies %>% select(!contains(c("r","m"))) %>% colnames()

## [1] "title"  "length" "budget" "votes"  "Action"

#!contains表示不包括

tibble(x1=1:10,
       x2=2:11,
       x3=letters[1:10])->data #数据框tibble优于data.frame
data

data %>% select(num_range("x",1:2))

data %>% select(x1,x2)

data %>% select(one_of("x1","x3"))

select_if

data %>% 
  select_if(~is.numeric(.)&n_distinct(.)>30)

x <- c(1,2,3,2,NA)
is.na(x)

## [1] FALSE FALSE FALSE FALSE  TRUE

is.na(x)%>% mean()#求缺失值的均值

## [1] 0.2

ggplot2movies::movies %>% select_if(~is.na(.) %>% mean()>0.3) %>% colnames()

## [1] "budget"

ggplot2movies::movies %>% select_if(~mean(is.na(.)>0.25)) %>% head()

#机器学习中经常用于处理缺失数据

select_at

选择指定某列

mtcars %>% select_at(.vars = c("mpg","am"))

select_all

选择所有列

选择行

slice

根据记录的位置选择行

iris %>% slice(1:7)

iris %>% slice(1:floor(n()/3)) %>% 
  count()  #floor表示向左取整

filter

iris$Species

##   [1] setosa     setosa     setosa     setosa     setosa     setosa    
##   [7] setosa     setosa     setosa     setosa     setosa     setosa    
##  [13] setosa     setosa     setosa     setosa     setosa     setosa    
##  [19] setosa     setosa     setosa     setosa     setosa     setosa    
##  [25] setosa     setosa     setosa     setosa     setosa     setosa    
##  [31] setosa     setosa     setosa     setosa     setosa     setosa    
##  [37] setosa     setosa     setosa     setosa     setosa     setosa    
##  [43] setosa     setosa     setosa     setosa     setosa     setosa    
##  [49] setosa     setosa     versicolor versicolor versicolor versicolor
##  [55] versicolor versicolor versicolor versicolor versicolor versicolor
##  [61] versicolor versicolor versicolor versicolor versicolor versicolor
##  [67] versicolor versicolor versicolor versicolor versicolor versicolor
##  [73] versicolor versicolor versicolor versicolor versicolor versicolor
##  [79] versicolor versicolor versicolor versicolor versicolor versicolor
##  [85] versicolor versicolor versicolor versicolor versicolor versicolor
##  [91] versicolor versicolor versicolor versicolor versicolor versicolor
##  [97] versicolor versicolor versicolor versicolor virginica  virginica 
## [103] virginica  virginica  virginica  virginica  virginica  virginica 
## [109] virginica  virginica  virginica  virginica  virginica  virginica 
## [115] virginica  virginica  virginica  virginica  virginica  virginica 
## [121] virginica  virginica  virginica  virginica  virginica  virginica 
## [127] virginica  virginica  virginica  virginica  virginica  virginica 
## [133] virginica  virginica  virginica  virginica  virginica  virginica 
## [139] virginica  virginica  virginica  virginica  virginica  virginica 
## [145] virginica  virginica  virginica  virginica  virginica  virginica 
## Levels: setosa versicolor virginica

iris %>% filter(Species=="virginica") %>% head()

iris %>% 
  filter(Sepal.Length>5) %>% datatable()

iris %>% filter(Sepal.Length>sd(Sepal.Length)) %>% nrow()

## [1] 150

iris %>% filter(Sepal.Length>7.5|Sepal.Width>7.5|Petal.Length>7.5|Petal.Width>7.5) #“|”表示或

iris %>% 
  filter(Sepal.Length>7.5,Sepal.Width>7.5,Petal.Length>7.5)

iris %>% filter(Species=="virginica",Sepal.Length>mean(Sepal.Length)) %>% head()

filter_if

iris %>% 
  filter_if(is.numeric,any_vars(abs(.-mean(.))>2*sd(.)))

#选出数值型的列，再选择这列中减去均值之后的数大于两倍标准差行

iris %>% 
  filter_if(~is.numeric(.)&n_distinct(.)>30,any_vars(.<mean(.))) %>% 
  head()

#选择数值的列，其独一无二的值大于30 ，然后选择这列中小于该列均值的行

filter all

iris %>% filter_all(any_vars(.>7.5),.preserve = T)

## Warning in Ops.factor(Species, 7.5): '>' not meaningful for factors

filter at

iris %>% filter_at(vars(ends_with("Length")),
                   all_vars(.<mean(.))) %>% datatable()

处理数据框名字

select

iris %>% select(sepal.length=Sepal.Length) %>% head()

rename

iris %>% rename(sepal.length=Sepal.Length) %>% head()

select_all

#把所有列变成大写
iris %>% select_all(toupper) %>% colnames()

## [1] "SEPAL.LENGTH" "SEPAL.WIDTH"  "PETAL.LENGTH" "PETAL.WIDTH"  "SPECIES"

select_if

iris %>% select_if(is.numeric,toupper) %>% colnames()

## [1] "SEPAL.LENGTH" "SEPAL.WIDTH"  "PETAL.LENGTH" "PETAL.WIDTH"

rename_all

rename_all(mtcars,str_to_upper) %>% head()#所用字符串变成大写

rename_all(mtcars,str_to_lower) %>% head()

rename_if

iris %>% 
  rename_if(is.numeric,str_to_lower) %>% head()#所用数值型列换成小写

排序变量

arange

iris %>% 
  arrange(desc(Species),Sepal.Length) %>% 
  datatable() #默认升序排列数据

#先按字母对SpecieS进行升序排序，然后再对Sepal.Length进行升序排序。

arange_all

arange_if

select选择特定列排在前面

iris %>% 
  select(starts_with("p"),everything()) %>% datatable()

#把含有“p"开头的变量排列到前面

iris %>% 
  select(Species,everything()) %>% datatable()

#把物种排到前面

current_vars按照字母顺序排序

mtcars %>% 
  select(sort(tidyselect::peek_vars())) %>% 
  datatable()

生成和删除若干列

mutate

iris %>% 
  mutate(Sepal.Area=Sepal.Length*Sepal.Width) %>% 
  head()

iris %>% 
  mutate(Sepal.Area=Sepal.Length*Sepal.Width,
         Sepal.Area.Mean=mean(Sepal.Area)) %>% 
  select(Sepal.Area,Sepal.Area.Mean,everything()) %>% 
  head()

#将生成的列放到前面

iris %>% 
  mutate(Sepal.Length=NULL) %>% 
  colnames()

## [1] "Sepal.Width"  "Petal.Length" "Petal.Width"  "Species"

#删除某列

iris1 <- iris
iris1$Species <- NULL
colnames(iris1)

## [1] "Sepal.Length" "Sepal.Width"  "Petal.Length" "Petal.Width"

row_number生成行序号

iris %>% 
  mutate(id=row_number()) %>% 
  head()

lag和lead

lag(1:10)#滞后一项

##  [1] NA  1  2  3  4  5  6  7  8  9

lag(1:10,2)#滞后两项

##  [1] NA NA  1  2  3  4  5  6  7  8

lead(1:10)#提前一项

##  [1]  2  3  4  5  6  7  8  9 10 NA

lead(1:10,2)#提前两项

##  [1]  3  4  5  6  7  8  9 10 NA NA

case_when对多个列进行变换

x <- sample(1:5,10,replace = T)
x

##  [1] 2 2 2 1 3 1 4 2 2 4

case_when(x==1~100,
          x==2~200,
          TRUE~as.numeric(x))

##  [1] 200 200 200 100   3 100   4 200 200   4

#1变成100，2变成200，其他为自己

cumall,cumany,cummean

cumall(2:10>1)

## [1] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE

cumany(1:10>1)

##  [1] FALSE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE

cummean(1:10)#累加均值

##  [1] 1.0 1.5 2.0 2.5 3.0 3.5 4.0 4.5 5.0 5.5

时间

year、month、day等

myDate <- ymd_hms("201103050925")
myDate %>% date()

## [1] "2020-11-03"

year(myDate)

## [1] 2020

month(myDate)

## [1] 11

week(myDate)

## [1] 44

day(myDate)

## [1] 3

hour(myDate)

## [1] 5

minute(myDate)

## [1] 9

second(myDate)

## [1] 25

week(today())

## [1] 35

yday、mda、wday、dday

yday(myDate)

## [1] 308

mday(myDate)

## [1] 3

wday(myDate)

## [1] 3

ddays(1)#一天多少秒

## [1] "86400s (~1 days)"

dyears(1)#一年多少秒

## [1] "31557600s (~1 years)"

wday(myDate)

## [1] 3

wday(myDate,label = T,abbr=F)

## [1] 星期二
## Levels: 星期日 < 星期一 < 星期二 < 星期三 < 星期四 < 星期五 < 星期六

now()

## [1] "2020-09-01 22:16:06 CST"

时间加加减减

myDate <- today()
myDate+years(1)

## [1] "2021-09-01"

myDate+months(1)

## [1] "2020-10-01"

myDate+days(1)

## [1] "2020-09-02"

myDate+hours(1)

## [1] "2020-09-01 01:00:00 UTC"

myDate+minutes(1)

## [1] "2020-09-01 00:01:00 UTC"

myDate+seconds(1)

## [1] "2020-09-01 00:00:01 UTC"

时间格式

a_date <- ymd_hms("20191224130701")
format(a_date)

## [1] "2019-12-24 13:07:01"

format(a_date,"%Y-%m-%d %H:%M:%S")

## [1] "2019-12-24 13:07:01"

format(now(),"%c")  #cuerrent locale's defsult

## [1] "周二 9月  1 22:16:06 2020"

format(now(),"%D")  #American style short date format

## [1] "09/01/20"

format(now(),"%F")  #ISO standard date format

## [1] "2020-09-01"

format(now(),"%Z")  #out put time zones as either numeric adjustments or time zone abbreviations

## [1] "CST"

其他常见工作场景

x <- seq.Date(from = ymd(20200401),to=ymd(20200410),by="1 day")
x

##  [1] "2020-04-01" "2020-04-02" "2020-04-03" "2020-04-04" "2020-04-05"
##  [6] "2020-04-06" "2020-04-07" "2020-04-08" "2020-04-09" "2020-04-10"

#得到一月（一周）的开始
floor_date(x,"month")

##  [1] "2020-04-01" "2020-04-01" "2020-04-01" "2020-04-01" "2020-04-01"
##  [6] "2020-04-01" "2020-04-01" "2020-04-01" "2020-04-01" "2020-04-01"

floor_date(x,"week")

##  [1] "2020-03-29" "2020-03-29" "2020-03-29" "2020-03-29" "2020-04-05"
##  [6] "2020-04-05" "2020-04-05" "2020-04-05" "2020-04-05" "2020-04-05"

ceiling_date(x,"month")-days(1)#上个月最后一天

##  [1] "2020-04-30" "2020-04-30" "2020-04-30" "2020-04-30" "2020-04-30"
##  [6] "2020-04-30" "2020-04-30" "2020-04-30" "2020-04-30" "2020-04-30"

ceiling_date(x,"month")-ddays(1)

##  [1] "2020-04-30" "2020-04-30" "2020-04-30" "2020-04-30" "2020-04-30"
##  [6] "2020-04-30" "2020-04-30" "2020-04-30" "2020-04-30" "2020-04-30"

ceiling_date(x,"month")-years(1)

##  [1] "2019-05-01" "2019-05-01" "2019-05-01" "2019-05-01" "2019-05-01"
##  [6] "2019-05-01" "2019-05-01" "2019-05-01" "2019-05-01" "2019-05-01"

ceiling_date(x,"month")-dyears(1)

##  [1] "2019-05-01 18:00:00 UTC" "2019-05-01 18:00:00 UTC"
##  [3] "2019-05-01 18:00:00 UTC" "2019-05-01 18:00:00 UTC"
##  [5] "2019-05-01 18:00:00 UTC" "2019-05-01 18:00:00 UTC"
##  [7] "2019-05-01 18:00:00 UTC" "2019-05-01 18:00:00 UTC"
##  [9] "2019-05-01 18:00:00 UTC" "2019-05-01 18:00:00 UTC"

ymd("20171011") %m+% months(1:4)

## [1] "2017-11-11" "2017-12-11" "2018-01-11" "2018-02-11"

ymd("20171011") +months(1:4)

## [1] "2017-11-11" "2017-12-11" "2018-01-11" "2018-02-11"

产生一个月序列，如果该值不会是月末值，用“+”,否则用“%m+%”强制执行月末行为

ymd(c("20171031","20170130"))%m+%months(1)

## [1] "2017-11-30" "2017-02-28"

ymd(c("20171031","20170130"))%within%
  interval(ymd("20171030"),ymd("20171130")) #是否包含于

## [1]  TRUE FALSE

int_overlaps(interval(ymd("20171028"),ymd("20171031")),
             interval(ymd("20171030"),ymd("20171130")))

## [1] TRUE

其他常见工作

simple <- "Hello, World!"
str_to_lower(simple)

## [1] "hello, world!"

str_to_upper(simple)

## [1] "HELLO, WORLD!"

str_to_sentence(simple)

## [1] "Hello, world!"

map(1:10,function(i){cat(1+1,"\n")})

## 2 
## 2 
## 2 
## 2 
## 2 
## 2 
## 2 
## 2 
## 2 
## 2

## [[1]]
## NULL
## 
## [[2]]
## NULL
## 
## [[3]]
## NULL
## 
## [[4]]
## NULL
## 
## [[5]]
## NULL
## 
## [[6]]
## NULL
## 
## [[7]]
## NULL
## 
## [[8]]
## NULL
## 
## [[9]]
## NULL
## 
## [[10]]
## NULL

map(1:10,~cat(1+1,"\n"))#"~"是function的另一种写法

## 2 
## 2 
## 2 
## 2 
## 2 
## 2 
## 2 
## 2 
## 2 
## 2

## [[1]]
## NULL
## 
## [[2]]
## NULL
## 
## [[3]]
## NULL
## 
## [[4]]
## NULL
## 
## [[5]]
## NULL
## 
## [[6]]
## NULL
## 
## [[7]]
## NULL
## 
## [[8]]
## NULL
## 
## [[9]]
## NULL
## 
## [[10]]
## NULL

map(iris,class)#第一个参数是数据，第二个是函数

## $Sepal.Length
## [1] "numeric"
## 
## $Sepal.Width
## [1] "numeric"
## 
## $Petal.Length
## [1] "numeric"
## 
## $Petal.Width
## [1] "numeric"
## 
## $Species
## [1] "factor"

iris$Sepal.Length %>% class

## [1] "numeric"

factor(1:10,labels = letters[1:10])#专门处理分类变量

##  [1] a b c d e f g h i j
## Levels: a b c d e f g h i j

factor(rep(c("male","female"),times=10))

##  [1] male   female male   female male   female male   female male   female
## [11] male   female male   female male   female male   female male   female
## Levels: female male

factor(rep(c("male","female"),times=10)) %>% fct_count()

总结：string处理字符串，forcats处理分类变量