R语言综合数据处理习题分享

内容简介：本文主要聚焦于R语言中tidyverse、dplyr、ggplot2、stringr等包进行数据处理及可视化的应用

习题一：探索nycflights13数据集

【1】、从flights数据中找出到达时间延误2小时或者更多的所有航班，并将生成的新数据保存为flight_arr2hr

library(tidyverse)
library(nycflights13)
flight_arr2hr<-flights%>%filter(dep_delay>=2)

【2】、以flight_arr2hr数据集根据目的地(dest)进行分组，统计出抵达每个目的地的航班数量，筛选出抵达航班数量前十名的目的地，将结果命名为top10_dest

top10_dest<-flight_arr2hr%>%
              group_by(dest)%>%
              summarise(n=n())%>%
              arrange(-n)%>%head(10)
top10_dest

【3】、从weather表中挑选出以下变量：year, month, day, hour, origin, humid, wind_speed，并将其与flight_arr2hr表根据共同变量进行左连接, 生成的新数据保存为flight_weather

flight_weather<-flight_arr2hr%>%
                left_join(select(weather,year, month, day, hour, origin, humid, wind_speed),
                          by=c("year",'month',"day","hour","origin"))
flight_weather

【4】、基于flight_weather数据集，根据不同出发地(origin)在平行的三个图中画出风速 wind_speed(x轴)和出发延误时间dep_delay(y轴)的散点图，以及平滑曲线。

library(grid)
library(ggplot2)
origins<-c("EWR","JFK","LGA")
pushViewport(viewport(layout = grid.layout(1,3)))  #设置1行3列的画布
vplayout <- function(x,y){viewport(layout.pos.row = x,layout.pos.col = y)}

i<-1
for(origin in origins){
  tmp_data<-flight_weather[flight_weather$origin==origin,]
  p<-tmp_data%>%ggplot(aes(x=wind_speed,y=dep_delay))+
    geom_point()+
    geom_smooth(formula=y~x,method = "lm")+
    labs(title=paste0(origin,"散点图"))
  print(p,vp=vplayout(1,i))
  i<-i+1
}

【5】、剔除flights数据集中arr_delay和dep_delay为NA的航班，记为not_cancel。并在其基础上，对到达机场以arr_delay的中位数统计计算出延误机场top10，将结果保存为worst_delay

not_cancel<-flights%>%filter(!is.na(arr_delay),!is.na(dep_delay))

worst_delay<-not_cancel%>%group_by(dest)%>%
  summarise(arr_delay_median=median(arr_delay))%>%
  arrange(-arr_delay_median)%>%
  head(10)
worst_delay

【6】、以worst_delay中的10个机场，在not_cancel中筛选对应的行，然后新增一列delay，delay将dep_delay分成三组：延误1小时之内、延误1-3小时、延误3小时以上的，并标记为<1h，1-3h，>3h，并计算各个分组比例，记为变量perc

worst_delay_group<-not_cancel%>%
  filter(dest%in%worst_delay$dest)%>%
  mutate(delay=ifelse(dep_delay<1,"<1h",
                      ifelse(dep_delay<3,"<3h",">3h")))

worst_delay_group%>%
  group_by(delay)%>%
  summarise(perc=n()/nrow(worst_delay_group))

【7】、在flights中筛选10月份飞行的数据，并对其缺失值进行查看并处理，保存为carrier_m10。对carrier_m10，判断一个月中是否每天都有航班的航空公司，如果有，并统计出缺飞的航公公司究竟缺飞了哪几天。

library(naniar) #查看缺失值的包
carrier_m10<-flights%>%filter(month==10)
carrier_m10%>%miss_var_summary() #查看各列缺失值

na_num_variable<-c("arr_delay","air_time","arr_time","dep_time","dep_delay")
for(variable in na_num_variable){
  carrier_m10[is.na(carrier_m10[variable]),variable]<-0
}

carrier_m10[is.na(carrier_m10$tailnum),"tailnum"]<-""
sum(is.na(carrier_m10)) #缺失值总数

从结果可知，arr_delay、air_time、...、tailnum为存在缺失值的变量，考虑tailnum为字符型变量，而其余均为数值型变量。因此，在进行缺失值填补时，分开处理即：数值型缺失补0，字符缺失为空。处理完成后，所有列均未存在缺失值！

接下来，统计10月缺飞的航公公司

#统计每天每个公司出行的班次
carrier_day<-carrier_m10%>%
  group_by(carrier,day)%>%
  summarise(count=n())

#考虑10月有31天,根据航空公司分组计数,筛选出计数少于31天,即为缺飞的
carrier_absent<-carrier_day%>%count(carrier)%>%filter(n<31)
carrier_absent

从结果可知，只有HA航空公司缺飞，10月它仅飞行了21天

carrier_absent_group<-carrier_m10%>%
  filter(carrier%in%carrier_absent$carrier)

carrier_absent_group<-split(carrier_absent_group,carrier_absent_group$carrier)

absent_day<-sapply(carrier_absent_group,
       function(x){
         setdiff(1:31,unique(x$day)) #取1:31的补集
       })
absent_day

最终输出结果表示，HA航公公司10月1日、3日、8日、…、31日没有飞行。

返回顶部

---

习题二：探索diamonds数据集

【1】、对diamonds数据集，生成一个新变量id，用于存储每条观测值所在的行数。挑选出id, x, y, z四个变量，将x, y, z的变量名存为新变量dimension，将x, y, z的值存为新变量length。转换后的长数据存为xyz_long。

library(reshape2)
diamonds$id<-1:nrow(diamonds)
xyz_long<-diamonds%>%select(id,x,y,z)%>%
            melt(id='id',measure=c("x","y","z"))
colnames(xyz_long)<-c("id","dimension","length")
head(xyz_long)

【2】、将xyz_long数据集转换回宽数据xyz_wide，宽数据xyz_wide包含id, x, y, z四个变量。

xyz_width<-spread(xyz_long,dimension,length)
head(xyz_width)

返回顶部

---

习题三：探索babynames数据集

【1】、统计babynames中name登记次数n的总和，命名为total，并取total大于2,600,000的名字及其总合，将其数据集保存为topNameM

library(babynames)
topNameM<-babynames%>%
  group_by(name)%>%
  summarise(total=sum(n))%>%
  filter(total>2600000)
topNameM

【2】 、从babynames中筛选出name在topNameM中的行，并保留name，sex，year，n变量，存为topBoth

【3】、将topBoth转为新表topBoth2，要求新表各列为：name、year、男性(M)、女性（F）在该年出生的总人数，以及新生变量both，表示每年同一名字下男女出生人数的总和

topBoth2<-topBoth%>%spread(key="sex",value="n")
topBoth2[is.na(topBoth2)]<-0
topBoth2$Both<-topBoth2$F+topBoth2$M
topBoth2

【4】、基于topBoth2，以name分组画出登记次数总和(both)随时间变化趋势图，并统计出1980年至2000年之间数量总和最多的名字。

#统计总和最多的名字
topBoth2%>%
  group_by(name)%>%
  summarise(count=sum(Both))%>%
  arrange(-count)%>%head(1)

#绘制趋势图
library(grid)
pushViewport(viewport(layout = grid.layout(2,4)))   #指定画图大小
vplayout <- function(x,y){viewport(layout.pos.row = x,layout.pos.col = y)}

k<-1
j<-1
name_group<-unique(topBoth2$name)
for(i in 1:length(name_group)){
  if(i>4){
    k<-2
    tmp_data<-filter(topBoth2,name==name_group[i])
    p<-ggplot(tmp_data,aes(x=year,y=Both))+
      geom_line()+
      labs(title=paste0(name_group[i],"趋势图"))
    print(p,vp=vplayout(k,j-4))
    j=j+1
  }else{
    tmp_data<-filter(topBoth2,name==name_group[i])
    p<-ggplot(tmp_data,aes(x=year,y=Both))+
      geom_line()+
      labs(title=paste0(name_group[i],"趋势图"))
    print(p,vp=vplayout(k,j))
    j=j+1
  }
}  

返回顶部

---

习题四：探索words数据集

【1】、根据stringr::words数据，统计每个单词的长度，按照其长度的中位数分为 【短单词】 和【长单词】两类，然后统计出每个单词的元音个数，以及元音比例，将上述生成的数据保存为word_type。该数据的变量名依次为word, word_length, word_type, num_vowel, proportion_vowel.

library(stringr)
word_type<-data.frame(sapply(words,function(x){return(str_length(x))}))
colnames(word_type)<-"word_length"
word_type$word<-rownames(word_type)
word_type<-word_type[,c(2,1)]
rownames(word_type)<-1:nrow(word_type)

word_type$word_type<-ifelse(word_type$word_length>median(word_type$word_length),"长单词 ","短单词")

vowel_count<-function(x){
  num_vowel<-0
  vowel<-c("a","e","u","i","o")
  x<-strsplit(x,"")[[1]]
  for(i in x){
    if(any(grepl(i,vowel))){
      num_vowel=num_vowel+1
    }
  }
  return(num_vowel)
}

word_type$num_vowel<-sapply(word_type$word,vowel_count)
word_type$proportion_vowel<-word_type$num_vowel/word_type$word_length
head(word_type)

【2】、请从words 中每次取x个单词，统计辅音结尾的比率，并将其重复n次，将其写成函数。 要求x=10，n=5000，并且运行结果需产生一个新表，里面变量nonvowel_ratio，同时产生一个直方图，并伴有密度曲线。

x=10;n=5000

#统计辅音函数,是辅音则记为1,否为0
count_nonvowel<-function(x){
  vowel<-c("a","e","u","i","o")
  if(any(endsWith(x,vowel))){
    return(0)
  }else{
    return(1)
  }
}

#返回两个参数,参数1为辅音比率向量,参数二为ggplot绘图
caculate_novel<-function(n,x){
  nonvowel_ratio<-c()
  for(i in 1:n){
    tmp_words<-sample(words,x)
    nonvowel_counts<-sum(sapply(tmp_words,count_nonvowel))
    nonvowel_ratio1<-nonvowel_counts/length(tmp_words)
    nonvowel_ratio<-c(nonvowel_ratio,nonvowel_ratio1)
  }
  p<-nonvowel_ratio%>%as.data.frame()%>%
    ggplot(aes(x=nonvowel_ratio,y=..density..))+
    geom_histogram(bins=15,color="#88ada6", fill="#fffbf0",alpha=0.25)+
    geom_density()
  
  list_ratio<-list(nonvowel_ratio,p)
  return(list_ratio)
}
novel_ratio<-caculate_novel(n,x)
novel_ratio[[1]]
novel_ratio[[2]]

返回顶部

---

习题五：探索官方package数据集

使用 dbCRAN <- tools::CRAN_package_db() 获取cran上R-packages 的相关数据。dbCRAN的每一行是对一个包的信息的描述，我们只需要Package,Maintainer,Author,Depends 四个变量，其含义为包名，维护者，作者和该包依赖于哪些包以及R的版本，将这四列保存为 dbName，执行以下操作：
（注意： CRAN_package_db() 该条命令可能因网络原因无法获取数据，建议修改下载包的镜像为清华镜像）

【1】、写一个函数cleanNames 用来：去除一列中的各种括号以及括号里面的内容，并去除换行和行尾空格

cleanNames<-function(string){
  string%>%
    str_replace_all("\\(.*?\\)","")%>%  #去除()
    str_replace_all("\\[.*?\\]","")%>%  #去除[]
    str_replace_all("<.*?>","")%>%  #去除<>
    str_replace_all("\n","")%>%  #去除换行符
    str_trim() #去除两边空格
}

【2】、对 dbNames的后三列，不用显式循环，执行上面的函数，并保存为 一个tibble，名为 dbClean

dbCRAN<-tools::CRAN_package_db()
dbName<-dbCRAN%>%select(Package,Maintainer,Author,Depends)
dbClean<-as_tibble(apply(dbName[,2:4],2,cleanNames))
dbClean<-cbind(dbName[,1],dbClean)
colnames(dbClean)[1]<-"Packages"
head(dbClean)

【3】、对dbClean，找出维护最多包的 Maintainer 前10，使用条形图展示

top10_Maintainer<-dbClean%>%
                  group_by(Maintainer)%>%
                  summarise(count=n())%>%
                  arrange(-count)%>%head(10)

ggplot(top10_Maintainer,aes(x=reorder(Maintainer,count),y=count))+
  geom_bar(stat = 'identity',fill='#0CB6F2',alpha=0.7)+
  coord_flip()+
  geom_text(aes(label=count, y=count+2), vjust=0.5)+
  labs(x="",y="人数",title="维护前10名的Maintainer")+
  theme(
    plot.title = element_text(hjust = 0.5),
    axis.text.x = element_text(angle=90)) 

【4】、对 dbClean 的 Depends，利用 ","来分割，建立tibble，并找出被依赖最多的10个包

depends_group<-separate_rows(dbClean,Depends,sep=",")
depends_group%>%
  group_by(Packages)%>%
  summarise(count=n())%>%
  arrange(-count)%>%head(10)

【5】、从 dbClean 中随机抽取Depends列不为NA的100行形成一个子集，保存为dbSample。其次，从dbSample的Depends列中提取出所有出现在该列的包，并去除"R"及其版本号。最后，在数据集dbSample的Depends列之后增加 N 列，分别命名为"dep_包的名字"，这些字段的类型为逻辑型，TRUE和FALSE分别表示某一行所表示的包是否出现在Depends列中

set.seed(4869)
dbSample<-dbClean[!is.na(dbClean$Depends),]
dbSample<-dbSample[sample(nrow(dbSample),100),]
dbSample<-separate_rows(dbSample,Depends,sep=",")
dbSample$Depends<-sapply(dbSample$Depends,cleanNames)

dbSample<-dbSample%>%filter(Depends!="R",Depends!="")

tmp_depends<-data.frame(matrix(0,nrow(dbSample),length(unique(dbSample$Depends))))
colnames(tmp_depends)<-paste0(unique(dbSample$Depends))
dbSample<-cbind(dbSample,tmp_depends)

for(i in 5:ncol(dbSample)){
  dbSample[,i]<-ifelse(dbSample$Depends==colnames(dbSample)[i],TRUE,FALSE)
}

colnames(dbSample)[5:ncol(dbSample)]<-paste0("dep_",colnames(tmp_depends))

返回顶部

以上就是本次分享的全部内容~