《R语言编程艺术》书上代码实现---第五章数据框

第五章数据框

5.1创建数据框

#数据框与矩阵不同，每一列都可以是一个模式
kids=c("jack","jill")
ages=c(12,13)
d=data.frame(kids,ages,stringsAsFactors = F)
d#stringAsFactors默认t字符向量
#5.1.1访问数据框
d[[1]]
d$kids
d[,1]
str(d)

#5.1.2扩展案例：考试成绩的回归分析（续）
examsquiz=read.table("ExamsQuiz.txt",header = F)
names(examsquiz)=c("Exam.1","Exam.2","Quiz")
examsquiz

5.2其他矩阵式操作

#5.2.1提取子数据框
examsquiz[2:5,]
examsquiz[2:5,2]
class(examsquiz[2:5,2])#R创建的向量不是数据框
examsquiz[2:5,2,drop=F] #使用drop生成是数据框
class(examsquiz[2:5,2,drop=F] )
examsquiz[examsquiz$Exam.1>3.8,]
examsquiz[,examsquiz$Exam.1>3.8,drop=F]

#5.2.2缺失值的处理
x=c(2,NA,4)
mean(x)
mean(x,na.rm = T)#设置na.rm=T忽略缺失值

subset(examsquiz,examsquiz$Exam.1>3.8)
subset(examsquiz,Exam.1>3.8) #应为指出了数据可以不用$

#去掉含有一个遇上的缺失值NA观测
d4=data.frame(kids=c("jack",NA,"jillian","john"),states=c("ca","ma","ma",NA))
complete.cases(d4)#判断行是否有缺失值
d4[complete.cases(d4),] #显示没有缺失值的行

#5.2.3使用rbind()和cbind()函数
rbind(d4,list("laira",19))

eq=cbind(examsquiz,examsquiz$Exam.2-examsquiz$Exam.1)
eq
examsquiz$Examdiff=examsquiz$Exam.2-examsquiz$Exam.1 #赋予新列数据
examsquiz

d4$one=1 #循环补齐一列赋予相同数值
d4

#5.2.4使用apply()
apply(examsquiz,1,max) #1表示对行应用函数，即对学生

#5.2.5扩展案例：工资研究
all2006=read.csv("2006.csv",header = T,as.is=T)
#as.is是stringAsFactors=FALSE的另一种形式
head(all2006)
all2006[all2006$Wage_Per=="Year",]
all2006[all2006$Wage_Offered_From>2000,]
all2006[all2006$Prevailing_Wage_Amount==200,]
all2006$rat=all2006$Wage_Offered_From/all2006$Prevailing_Wage_Amount
head(all2006)

medrat=function(dataframe){
  return((median(dataframe$rat,na.rm = T)))
}#计算新列中位数

#grep()函数识别含有给定职位名称的行
se2006=all2006[grep("Software Engineer",all2006),]
prg2006=all2006[grep("Programmer",all2006),]
ee2006=all2006[grep("Electrinics Enginner",all2006),]

makecrop=function(corname){
  t=all2006[all2006$Employer_Name==corpname,]
  return(t)
}

#coplist=c("MICRO")

5.3合并数据框

#merge函数
d1=data.frame(kids=c("jack"),ages=12)
merge(d4,d1)#按照两个表共同变量合并

d3=data.frame(ages=c(12,10,7),pals=c("jack","jill","lillian"))
d3
merge(d4,d3,by.x="kids",by.y = "pals") #两个变量不同名合并

d2a=data.frame(ages=c(12,10,7,15),kids=c("jack","jill","lillian","jill"))
d2a
d1=data.frame(kids=c("jack","jill","lillian","john"),states=c("CA","MA","MA","HI"))
merge(d1,d2a) #两个jill 一个jill居住地未知却合并了，选择匹配变量时必须谨慎

#扩展案例：员工数据库
#没有DA、DB数据资料

5.4应用数据框的函数

#lapply 和sapply函数可以应用于数据框
#5.4.1在数据框上应用lapply()和sapply()函数
d=data.frame(kids=c("jack","jill"),ages=c(12,10))
d
d1=lapply(d,sort) #作用于数据框的每一列，将返回值置于一个列表
d1
as.data.frame(d1)#将结果转化为字符串 ，但是没意义丢失了年龄和名字的对应关系

#5.4.2扩展案例：应用Logistic模型
#利用鲍鱼数据用高度、重量、环数预测性别
aba <- read.csv("abalone.data",header=T,as.is=F)
#数据框重命名
names(aba)=c(	"Gender",	"Length",	"Diam",	"Height",	"Whole",	"Shucked",	"Viscera",	"Shell",	"Rings" )
head(aba)
abamf <- aba[aba$Gender != "I",]  # exclude infants from the analysis
lftn <- function(clmn) {
   glm(abamf$Gender ~ clmn, family=binomial)$coef #返回回归系数的估计值 
}
loall <- sapply(abamf[,-1],lftn)  
loall
class(loall)

#5.4.3扩展案例：学习中文方言的辅助工具
#没找到数据
mapsound <- function(df,fromcol,tocol,sourceval) {
   base <- which(df[[fromcol]] == sourceval)
   basedf <- df[base,]
   # determine which rows of basedf correspond to the various mapped
   # values
   sp <- split(basedf,basedf[[tocol]])
   retval <- list()
   retval$counts <- sapply(sp,nrow)
   retval$images <- sp
   return(retval)
}