R 语文组数据分析 step1
本代码包含：
1、原始数据进行拆分（作文和普通题目分开分析）
2、选项分析、得分分布
3、清洗数据，去除缺失>5的被试
4、ABCD作答转换为[0,full]
5、缺失值替换
#################################################################################################### ##############################revised version by Joanna Liu on Apr.13.############################## #################################################################################################### library(openxlsx) setwd("F:/")#红点标记的为需要更改的地方 data<-read.csv(".csv",na.strings="#")##读入原始数据 ##定义数据## dat<-data[,-c(1:5)]##无作文无被试信息 原始数据 z1dat<-data[,c(23:32)]##作文1 z2dat<-data[,c(33:42)]##作文2 info<-data[,c(1:4)]#信息 z1<-na.omit(z1dat) aa<-z1[,c(1:5)] bb<-z1[,c(6:10)] aa=matrix(as.numeric(as.matrix(aa)),nrow=nrow(aa))##如果数据是numeric就不用这两行代码 bb=matrix(as.numeric(as.matrix(bb)),nrow=nrow(bb))##在excel里也可事先变换成数值 xz<-(aa+bb)/2 z1[,11:15]<-xz z1[,16]<-apply(xz,1,sum) z1index<-as.numeric(row.names(z1)) z1info<-info[z1index,] endz1<-cbind(z1info,z1) z2<-na.omit(z2dat) aa<-z2[,c(1:5)] bb<-z2[,c(6:10)] aa=matrix(as.numeric(as.matrix(aa)),nrow=nrow(aa)) bb=matrix(as.numeric(as.matrix(bb)),nrow=nrow(bb)) xz<-(aa+bb)/2 z2[,11:15]<-xz z2[,16]<-apply(xz,1,sum) z2index<-as.numeric(row.names(z2)) z2info<-info[z2index,] endz2<-cbind(z2info,z2) wb<-createWorkbook() addWorksheet(wb,sheetName = "作文一") addWorksheet(wb,sheetName = "作文二") writeData(wb,"作文一",endz1) writeData(wb,"作文二",endz2) #选项分析# new<-dat row<-nrow(new) A_1<-(round(apply(new,2,function(new)length(which(new=="A"))/row),4))*100 A_2<-(round(apply(new,2,function(new)length(which(new=="B"))/row),4))*100 A_3<-(round(apply(new,2,function(new)length(which(new=="C"))/row),4))*100 A_4<-(round(apply(new,2,function(new)length(which(new=="D"))/row),4))*100 A_5<-(round(apply(new,2,function(new)(sum(is.na(new)))/row),4))*100 xxresult<-do.call(rbind,lapply(paste("A",1:5,sep="_"),get)) #得分百分比# A_1<-(round(apply(new,2,function(new)length(which(new==0))/row),4))*100 A_2<-(round(apply(new,2,function(new)length(which(new==1))/row),4))*100 A_3<-(round(apply(new,2,function(new)length(which(new==2))/row),4))*100 A_4<-(round(apply(new,2,function(new)length(which(new==3))/row),4))*100 A_5<-(round(apply(new,2,function(new)length(which(new==4))/row),4))*100 A_6<-(round(apply(new,2,function(new)length(which(new==5))/row),4))*100 A_7<-(round(apply(new,2,function(new)length(which(new==6))/row),4))*100 A_8<-(round(apply(new,2,function(new)length(which(new==7))/row),4))*100 A_9<-(round(apply(new,2,function(new)length(which(new==8))/row),4))*100 A_10<-(round(apply(new,2,function(new)length(which(new==9))/row),4))*100 A_11<-(round(apply(new,2,function(new)length(which(new==10))/row),4))*100 A_12<-(round(apply(new,2,function(new)length(which(new==11))/row),4))*100 A_13<-(round(apply(new,2,function(new)length(which(new==12))/row),4))*100 A_14<-(round(apply(new,2,function(new)length(which(new==13))/row),4))*100 A_15<-(round(apply(new,2,function(new)length(which(is.na(new)))/row),4))*100 xxresult<-do.call(rbind,lapply(paste("A",1:15,sep="_"),get)) rownames(xxresult2)<-c(0,1:12,"#","NA") xx<-rbind(xxresult,xxresult2) ##剔除缺失作答数据## 使用无信息无作文数据 r<-apply(dat,1,function(dat)sum(is.na(dat))) a<-which(r>=5)##这里r是定义缺失多少就删掉的数 newdat<-dat[-a,]#newdat<-dat[r<5,]###############newdat newin<-info[-a,] endat<-cbind(newin,newdat)#删除缺失后的数据 saveWorkbook(wb,file = "第一步结果/D作文数据.xlsx")#含被试信息+均分+总分 write.xlsx(xx,"第一步结果/D选项分析结果.xlsx")#可选择csv格式输出 write.xlsx(endat,file="第一步结果/D剔除后数据.xlsx")#含被试信息 ###ABCD转换1234### 不含信息 zhhdata<- ##缺失值替换## 只替换非作文数据 data<-read.csv("F:/~系统用户文件/Desktop/新建文件夹/D得分.csv",na.strings="NA")##读入原始得分的清洗后数据
data<-data[,-c(1:5)]##注意去掉不用的信息
#################################################### 替换 ###########################################
allscore<-apply(data,1,sum) tmissnum<-which(is.na(allscore)) #所有缺失行位置 missdata<-data[tmissnum,,drop=FALSE] ##提取缺失数据的行 compledata<-data[-tmissnum,,drop=FALSE]##提取非缺失数据的行 for(i in c(tmissnum)){ missnum<-which(is.na(data[i,])) #被试缺失列位置 compscore<-apply(compledata[,-missnum],1,sum) #完整总分 onescore<-sum(data[i,-missnum])##去掉缺失题目的被试i的总分 orderone<-rank(c(onescore,compscore))[1] ####被试i在总分的位置 for(j in c(missnum)){ trdata<-(sort(compledata[,j])[orderone])##对被试i缺失的题目按总分排序得到与被试i对应等级的人的得分 data[i,j]<-trdata##被试i第j题的得分 } }
#################################################### 替换 ###########################################
write.xlsx(data,file="F:/缺失替换后数据.xlsx")##替换结果写入xlsx或csv
记录代码中用到的包和函数：
1、openxlsx包，可以直接打开xlsx格式的表格，可以在一个表内写入多个sheet，比csv在这一点上相对方便。
但是也有个毛病就是，批量读入表格时，read.xlsx应用失败了，不得已转为read.csv进行。也有可能仅仅是代码的问题。
2、do.call函数使用很方便，y <- do.call("cbind", lapply(x, "is.na")) 例如这种。第一个元素是函数名，第二个元素是应用此函数的list。
另外就是apply函数和cbind，rbind。
