技巧篇：常用的R代码汇总

模块1：Xpath的一些练习

#install.packages("rvest")
#install.packages("xlsx")
#install.packages("base")library(base)
library(xlsx)
library(rvest) #爬虫
library(XML)
library(RCurl)
library(rjson)
library(rJava)
# install.packages("RJSONIO")
# install.packages("jsonlite")
??rvest
txt="abcd123456"
sub(pattern = ".*(\\d.+?)",replacement = "\\1",txt)txt<-"dataurl: \"http://datainterface.eastmoney.com/EM_DataCenter/JS.aspx?type=SR&sty=YJBB&code=000001&st={sortType}&sr={sortRule}&p={page}&ps={pageSize}&js=var {jsname}={pages:(pc),data:[(x)]}{param}\","RCurl="http://data.eastmoney.com/bbsj/stock000001/yjbb.html"
#response<-getURL(RCurl) # 直接抓源代码
#response<-getURL(RCurl,encoding ="utf-8") # 怎么转码？
txt<-readLines(RCurl)#读行
html<-txt[grep(pattern = "dataurl",txt)]#解析源代码，正则找行代码中含有dataurl的行
html<-sub(pattern = "\\{.+\\}.+",replacement = "",html)
NewUrl<-sub(pattern = "\\s.+dataurl:.*?(http:.+)&st=",replacement = "\\1",html)
NewUrlwrite.table(response,"~/re.txt",row.names=F,quote=FALSE,fileEncoding = "UTF-8")#============Model_One=================
url<-"http://www.scsf.gov.cn/website/second_orgInfo?aab001=510100030301070000&aab019="
temp<-getURL(url)
readHTMLTable(temp)#============案例1：取如家地址及分布================# install.packages("RCurl")
# install.packages("XML")library(bitops)
library(RCurl)
library(XML)url_initial <- "http://www.homeinns.com/homeinn-hotel"
txt_initial <- getURL(url_initial, .encoding="utf-8")
txt_initial <- htmlParse(txt_initial, asText=TRUE, encoding="utf-8")
txt_pinyin <- unlist(getNodeSet(doc=txt_initial, path="//ul[@class='ml_order_link']/li/a/@href"), use.names=FALSE)# 参考：http://www.52ij.com/jishu/XML/12424.html
# 参考：http://www.w3school.com.cn/xpath/xpath_syntax.asp
# 获取所有城市的拼音代码
getNodeSet(doc=txt_initial, path="//ul[@class='ml_order_link']/li/a/@href")url_head <- "http://www.homeinns.com/jieyang/homeinn"
txt_head <- getURL(url_head, .encoding="utf-8")
txt_head <- htmlParse(txt_head, asText=TRUE, encoding="utf-8")
maxpage <- as.numeric(unlist(getNodeSet(doc=txt_head, path="//input[@id='maxPage']/@value"), use.names=FALSE))
# 获取每个城市如家酒店的最大页码url_hotellist <- "http://www.homeinns.com/beijing/homeinn"
txt_hotellist <- getURL(url_hotellist, .encoding="utf-8")
txt_hotellist <- htmlParse(txt_hotellist, asText=TRUE, encoding="utf-8")
iconv(unlist(getNodeSet(doc=txt_hotellist, path="//a/@hotelname"), use.names=FALSE),"utf-8","gbk")
# 获取某个城市首页所有酒店名称
# 通过hotelname属性直接定位酒店名称
# 获取的酒店名称全是乱码
# 乱码解决参考资料：http://bbs.pinggu.org/thread-3335814-1-1.htmlt<-iconv(unlist(getNodeSet(doc=txt_hotellist, path="//ul[@class='list_intro_address_tj']/@title"), use.names=FALSE), "utf-8", "gbk")
mode(t)
t
x <- getNodeSet(doc=txt_hotellist, path="//ul[@class='list_intro_address_tj']/text()")
x
x<-xmlNode(doc=txt_hotellist, path="//ul[@class='list_intro_address_tj']/text()")
xmlValue(x)mode(xx)
# unlist后仍然是list？奇怪!#===========案例2：华丽的分割线==========
library(XML)
library(RCurl)
url <- 'http://www.pbc.gov.cn/diaochatongjisi/116219/116229/11877/index1.html'
html <- htmlParse(url,encoding="UTF-8")
hlist<-unlist(getNodeSet(html,path="//font[@class='newslist_style']/a/@href"),use.names = F)
hlist
tlist<-unlist(getNodeSet(html,path="//font[@class='newslist_style']/a/@title"),use.names = F)
tlist<-iconv(tlist,"utf-8","gbk")
tlist
rlist<-data.frame("herf"=hlist,"title"=tlist)
rlist
#下面是提取整个字节
raw <- iconv(xpathSApply(html,"//font[@class='newslist_style']/a[@href]",xmlAttrs),"UTF-8","GBK")
unlist(raw)
head(raw)#==========案例3：Xpath练习=============
library(XML)
library(RCurl)
url<-"http://sj.qq.com/myapp/"
html<-htmlParse(url,encoding = "UTF-8")url <- 'http://www.pbc.gov.cn/diaochatongjisi/116219/116229/11877/index1.html'
html<-htmlParse(url,encoding = "UTF-8")
xmlTreeParse(url,useInternal=TRUE,encoding="UTF-8")
html
xpathSApply(html,"//tr[@class='info']",use.names=F)url<-"http://aso100.com/index.php/trend/hotSearch"
html<-htmlParse(url,encoding = "UTF-8")
html
lit<-xpathSApply(html,"//div [@class='container']/div//li/a/text()",xmlValue)
unlist(lit,use.names = F)gett<-function(url){html<-htmlParse(url,encoding = "UTF-8")xpathSApply(html,"//*/[@class='info']",use.names=F)
}
gett(url)#===========案例4：读取祖父节点并分层==============
rm(list=ls())
library(XML)
library(RCurl)
library(tidyr)
library(dplyr)
url_initial <- "http://www.homeinns.com/homeinn-hotel"
txt_initial <- getURL(url_initial, .encoding="utf-8")
txt_initial <- htmlParse(txt_initial, asText=TRUE, encoding="utf-8")
getNodeSet(doc=txt_initial, path="//div [@class='ml_order_row']/ul/..")
txt_tt<-unlist(xpathSApply(txt_initial,path="//div [@class='ml_order_row']/ul",xmlValue),use.names = F)
tt<-matrix(txt_tt,ncol = 2,byrow =T)
td<-as.data.frame(tt)
colnames(td)<-c("a","b")
#将b列从因子转化成为字符，factor→character td$b<-as.character(td$b)
t1=transform(td,b=strsplit(td$b,"\\s"))
t1=unnest(t1,col = b)te<-td%>%transform(b= strsplit(b,"\\s"))%>%unnest(b)tf<-te[which(te$b!=""),]
write.csv(tf,"tf.csv")#=========案例5：=======================
for (i in 2:3) {url <- paste('http://www.cbrc.gov.cn/chinese/indexhome/04&current=',i,sep='')html <- htmlParse(url,encoding="UTF-8")htemp <- xpathSApply(html,"//td[@class='cc' and @height ='32']/a[@title]",xmlGetAttr,'href')h<- paste('http://www.cbrc.gov.cn',htemp,sep='')href <- unlist(h)ttemp <- xpathSApply(html,"//td[@class='cc' and @height ='32']/a[@title]",xmlGetAttr,'title')t <- iconv(ttemp,"utf-8","gbk")title <- unlist(t)
}
rlist<-data.frame("herf"=href,"title"=title)
write.csv(rlist,"rlist.csv")#=========案例6:获取飞行距离===============
library(RCurl)
#加载RCurl包
getKm<-function(x){d=debugGatherer()#设置debugGatherer，响应responsemyHttpheader<-c("User-Agent"="Mozilla/5.0 (Windows NT 6.1; rv:41.0) Gecko/20100101 Firefox/41.0","Accept"="text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8")#设置headers格式temp<-getURL(paste("http://zh.flightaware.com/live/flight/",x,sep=""),httpheader=myHttpheader,debugfunction=d$update,verbose=T,followlocation=T)#获取网页信息temp1<-d$value()[["headerIn"]]url1<-regmatches(temp1,regexpr(pattern = "http:.+Vary",temp1))url2<-unlist(strsplit(url1,"\r"))[1]t=regmatches(url2,regexpr("\\d+{1,}$",url2))t1=as.numeric(t)*1url=paste(unlist(strsplit(url2,t)),t1,sep="")#处理网页得到url地址temp2<-getURL(url)write(temp2,"~/tt.txt")k=regexpr(pattern = "计划飞行距离.+km(&nbsp|</td>)",temp2)dat=regmatches(temp2,k)#dat=regmatches(dat,regexpr("\\d.+\\d",dat))dat
}
getKm("EY311")
getKm("EY191")
getKm("KL1763")
getKm("KL1139")#=======案例7===================？charset:gb2132有问题
library(RCurl)
library(XML)url="http://binjianghuayuansm.fang.com/xiangqing"
myheader<-c("User-Agent"="Mozilla/5.0 (Windows; U; Windows NT 5.1; zh-CN; rv:1.9.1.6) ","Accept"="text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8","Accept-Language"="en-us","Connection"="keep-alive","Accept-Charset"="GB2312,utf-8;q=0.7,*;q=0.7"
)
i_url.html<-htmlParse(url,encoding = 'gbk')
i_url.html
id.vector<-xpathSApply(i_url.html,"//*[@class='lbox']",xmlValue)
id.vector
iconv(id.vector,"gbk","")getURL(url)#======案例8================library(RCurl)
library(XML)
library(stringr)
library(dplyr)
library(tidyr)
url<-c("http://www.jiwu.com/zhuanti/")
i_url.html<-htmlParse(url,encoding="UTF-8")
#读取链接
# xpath<-getNodeSet(i_url.html,"//div[@class='tabcon']")
# dat<-xpathSApply(i_url.html,"//div[@class='tabcon']",xmlValue)
One<-xpathSApply(i_url.html,"//div[@class='tabcon']/p",xmlValue)
Two<-unlist(xpathSApply(i_url.html,"//div[@class='tabcon']//ul",xmlValue),use.names = F)
Two=unlist(str_replace_all(Two,"\\s+"," "))
tt<-data.frame(a=One,b=Two)
tt$b=as.character(tt$b)te<-tt%>%transform(b= strsplit(b, " "))%>%unnest(b)

模块2：绘制物流路线地图

#_author:夏天
#_modify:xisuo
#_version:v1.1# ===========载入包===========
library(maps)
library(ggplot2)
library(sp)
library(lattice)
library(foreign)
library(maptools)
# library(directlabels)   ##不支持##
library(mapproj)
library(plyr)
library(dplyr)
library(reshape2)
library(ggsubplot)
library(RODBC)
library(grid)##导入订单路线数据##
setwd("C:\\Users\\users\\Documents\\R\\物流路线分析")
data=read.table(file="订单路线1.txt",header=T,sep=',')
data1=as.matrix(data)
head(data1)##除去同城物流路线（起始地等于目的地）##
a=c()
q=1
for (i in 1:1503)
{if (data1[i,1]==data1[i,2]){a[q]=iq=q+1}
}
a  ##储存同城物流路线的编号##
data2=data1[-a,]##储存包含一个中转地的路线到矩阵b##
b=matrix(0,nrow = 22796,ncol = 3)
s=1
for(i in 1:1461)
{p=data2[i,2]for(j in 1:1461){if (data2[j,1]==p){b[s,1]=data2[i,1]b[s,2]=data2[i,2]b[s,3]=data2[j,2]s=s+1}}
}
s     ##s为路线总数####根据起始地和目的地查询路线##
m="广州市"
n="北京市"##提取起始地和目的地的经纬度数据##
citydata=read.table(file="城市经纬度数据1.txt",header=T,sep=',')
routenumber=read.table(file="订单路线次数1.txt",header=T,sep=',')
for(i in 1:dim(citydata)[1])
{if(citydata[i,1]==m){long1=citydata[i,2]lat1=citydata[i,3]}if(citydata[i,1]==n){long2=citydata[i,2]lat2=citydata[i,3]}
}##起始地与目的地之间的距离##
distance1=sqrt((long1-long2)^2+(lat1-lat2)^2)##直达路线##
route=matrix(nrow=1,ncol=4)   ##储存直达路线和中转路线##
citysite=matrix(nrow=1,ncol=3)   ##储存城市经纬度##
d=dim(data2)
g=1    ##group数据##
for(i in 1:d[1])
{if(data2[i,1]==m & data2[i,2]==n){for (j in 1:dim(routenumber)[1]){if (routenumber[j,1]==m & routenumber[j,2]==n){number1=routenumber[j,3]   ##订单次数数据##}}route=rbind(route,matrix(c(g,long1,lat1,number1,g,long2,lat2,number1),nrow=2,ncol=4,byrow=T))citysite=rbind(citysite,matrix(c(m,long1,lat1,n,long2,lat2),nrow=2,ncol=3,byrow=T))g=g+1}
}##中转一次路线##
for(i in 1:s)
{if(b[i,1]==m & b[i,3]==n){for (j in 1:dim(citydata)[1]){if (citydata[j,1]==b[i,2]){long3=citydata[j,2]lat3=citydata[j,3]distance2=sqrt((long3-long1)^2+(lat3-lat1)^2)+sqrt((long3-long2)^2+(lat3-lat2)^2)}}if (distance2<(distance1*1.3)){for (j in 1:dim(routenumber)[1]){if (routenumber[j,1]==m & routenumber[j,2]==b[i,2]){number1=routenumber[j,3]}if (routenumber[j,1]==b[i,2] & routenumber[j,2]==n){number2=routenumber[j,3]}}citysite=rbind(citysite,matrix(c(b[i,2],long3,lat3),nrow=1,ncol=3,byrow=T))route=rbind(route,matrix(c(g,long1,lat1,number1,g,long3,lat3,number1,g+1,long3,lat3,number2,g+1,long2,lat2,number2),nrow=4,ncol=4,byrow=T))g=g+2}}
}
route=data.frame(route[-1,])
citysite=data.frame(citysite[-1,])
names(route)=c("group","long","lat","number")
names(citysite)=c("city","long","lat")citysite_copy=citysite
citysite_copy[,2]=as.double(sapply(citysite['long'],as.character))
citysite_copy[,3]=as.double(sapply(citysite['lat'],as.character))
citysite_copy##导入地图和数据##
mymap  = readShapePoly(system.file("shapes/bou2_4p.shp",package = 'maptools'))       # 读取地图空间数据
mymapd  <- fortify(mymap)           #转化为数据框citydata1=read.table(file="订单路线覆盖城市1.txt",header=T,sep=',')
citydata1=citydata[,-4]t1=ggplot()+geom_polygon(data=mymapd,aes(x=long,y=lat,group=group),color="grey60",fill="white")+geom_line(data=route,aes(x=long,y=lat,group=group,color=number),arrow=arrow(angle=10,length=unit(0.2,"inches"),ends='last',type = 'closed'))+scale_color_continuous(name='number',breaks=c(0,20,80,160),low = 'blue', high = 'red',guide='colourbar')+geom_point(data=citysite_copy,aes(x=long,y=lat))+  geom_text(aes(x=long,y=lat,label=city),data=citysite_copy,color="gray0",size=5)+ylim(15,55)+expand_limits()+theme(panel.grid = element_blank(),panel.background = element_blank(),axis.text = element_blank(),axis.ticks = element_blank(),axis.title = element_blank(),legend.background = element_blank(),legend.position='right',legend.title = element_text(colour='grey30',size=16),legend.text = element_text(colour="black", face = "bold",size=16),# legend.justification=c(0,0), # 这个参数设置很关键# legend.position=c(0.05,0.1),plot.margin = unit(c(0,0,0,0),"cm"),legend.key.size=unit(1.5,'cm'))
t1##所有订单路线图##
route1=matrix(nrow=1,ncol=5)
g1=1
for(i in 1:dim(data2)[1])
{for (j in 1:dim(citydata)[1]){if (citydata[j,1]==data2[i,1]){long1=citydata[j,2]lat1=citydata[j,3]}if (citydata[j,1]==data2[i,2]){long2=citydata[j,2]lat2=citydata[j,3]}}for(h in 1:dim(routenumber)[1]){if (routenumber[h,1]==data2[i,1] & routenumber[h,2]==data2[i,2]){number1=routenumber[h,3]}}route1=rbind(route1,matrix(c(g1,long1,lat1,number1,data2[i,1],g1,long2,lat2,number1,data2[i,2]),nrow=2,ncol=5,byrow=T))g1=g1+1
}
route1=data.frame(route1[-1,])
names(route1)=c("group","long","lat","number","city")t2=ggplot()+geom_polygon(data=mymapd,aes(x=long,y=lat,group=group),color="grey60",fill="white")+geom_line(data=route1,aes(x=long,y=lat,group=group,color=number),arrow=arrow(angle=10,length=unit(0.2,"inches"),ends='last',type = 'closed'))+scale_color_continuous(name='number',breaks=c(0,20,80,160),low = 'blue', high = 'red',guide='colourbar')+geom_point(data=route1,aes(x=long,y=lat))+  geom_text(aes(x=long,y=lat,label=city),data=route1,color="gray0",size=5)+ylim(15,55)+expand_limits()+theme(panel.grid = element_blank(),panel.background = element_blank(),axis.text = element_blank(),axis.ticks = element_blank(),axis.title = element_blank(),legend.background = element_blank(),legend.position='right',legend.title = element_text(colour='grey30',size=16),legend.text = element_text(colour="black", face = "bold",size=16),# legend.justification=c(0,0), # 这个参数设置很关键# legend.position=c(0.05,0.1),plot.margin = unit(c(0,0,0,0),"cm"),legend.key.size=unit(1.5,'cm'))
t2##次数5次以上的订单路线图##
data3=read.table(file="5次以上订单路线1.txt",header=T,sep=',')
data3=as.matrix(data3)route2=matrix(nrow=1,ncol=5)
g2=1
for(i in 1:dim(data3)[1])
{for (j in 1:dim(citydata)[1]){if (citydata[j,1]==data3[i,1]){long1=citydata[j,2]lat1=citydata[j,3]}if (citydata[j,1]==data3[i,2]){long2=citydata[j,2]lat2=citydata[j,3]}}for(h in 1:dim(routenumber)[1]){if (routenumber[h,1]==data3[i,1] & routenumber[h,2]==data3[i,2]){number1=routenumber[h,3]}}route2=rbind(route2,matrix(c(g2,long1,lat1,number1,data3[i,1],g2,long2,lat2,number1,data3[i,2]),nrow=2,ncol=5,byrow=T))g2=g2+1
}
route2=data.frame(route2[-1,])
names(route2)=c("group","long","lat","number","city")route2_copy=route2
route2_copy[,1]=as.double(sapply(route2['group'],as.character))
route2_copy[,2]=as.double(sapply(route2['long'],as.character))
route2_copy[,3]=as.double(sapply(route2['lat'],as.character))
route2_copy[,4]=as.double(sapply(route2['number'],as.character))t3=ggplot()+geom_polygon(data=mymapd,aes(x=long,y=lat,group=group),color="grey60",fill="white")+geom_line(data=route2_copy,aes(x=long,y=lat,group=group,color=number),arrow=arrow(angle=10,length=unit(0.2,"inches"),ends='last',type = 'closed'))+scale_color_continuous(name='number',breaks=c(0,20,80,160),low = 'blue', high = 'red',guide='colourbar')+geom_point(data=route2_copy,aes(x=long,y=lat))+  geom_text(aes(x=long,y=lat,label=city),data=route2_copy,color="gray0",size=5)+ylim(15,55)+expand_limits()+theme(panel.grid = element_blank(),panel.background = element_blank(),axis.text = element_blank(),axis.ticks = element_blank(),axis.title = element_blank(),legend.background = element_blank(),legend.position='right',legend.title = element_text(colour='grey30',size=16),legend.text = element_text(colour="black", face = "bold",size=16),# legend.justification=c(0,0), # 这个参数设置很关键# legend.position=c(0.05,0.1),plot.margin = unit(c(0,0,0,0),"cm"),legend.key.size=unit(1.5,'cm'))
t3##次数50次以上的订单路线图##
data4=read.table(file="50次以上订单路线1.txt",header=T,sep=',')
data4=as.matrix(data4)route3=matrix(nrow=1,ncol=5)
g3=1
for(i in 1:dim(data4)[1])
{for (j in 1:dim(citydata)[1]){if (citydata[j,1]==data4[i,1]){long1=citydata[j,2]lat1=citydata[j,3]}if (citydata[j,1]==data4[i,2]){long2=citydata[j,2]lat2=citydata[j,3]}}for(h in 1:dim(routenumber)[1]){if (routenumber[h,1]==data4[i,1] & routenumber[h,2]==data4[i,2]){number1=routenumber[h,3]}}route3=rbind(route3,matrix(c(g3,long1,lat1,number1,data4[i,1],g3,long2,lat2,number1,data4[i,2]),nrow=2,ncol=5,byrow=T))g3=g3+1
}
route3=data.frame(route3[-1,])
names(route3)=c("group","long","lat","number","city")route3_copy=route3
route3_copy[,1]=as.double(sapply(route3['group'],as.character))
route3_copy[,2]=as.double(sapply(route3['long'],as.character))
route3_copy[,3]=as.double(sapply(route3['lat'],as.character))
route3_copy[,4]=as.double(sapply(route3['number'],as.character))p=ggplot()+geom_polygon(data=mymapd,aes(x=long,y=lat,group=group),color="grey60",fill="white")+geom_line(data=route3_copy,aes(x=long,y=lat,group=group,color=number),arrow=arrow(angle=10,length=unit(0.2,"inches"),ends='last',type = 'closed'))+scale_color_continuous(name='number',breaks=c(0,20,80,160),low = 'blue', high = 'red',guide='colourbar')+geom_point(data=route3_copy,aes(x=long,y=lat))+  geom_text(aes(x=long,y=lat,label=city),data=route3_copy,color="gray0",size=5)+ylim(15,55)+expand_limits()+theme(panel.grid = element_blank(),panel.background = element_blank(),axis.text = element_blank(),axis.ticks = element_blank(),axis.title = element_blank(),legend.background = element_blank(),legend.position='right',legend.title = element_text(colour='grey30',size=16),legend.text = element_text(colour="black", face = "bold",size=16),# legend.justification=c(0,0), # 这个参数设置很关键# legend.position=c(0.05,0.1),plot.margin = unit(c(0,0,0,0),"cm"),legend.key.size=unit(1.5,'cm'))# ====输出图形====
png('~/test001.png',width=1200,height=1000,units="px",bg = "transparent")
print(p)
dev.off()

模块3：以前的一些练习代码

rm(list=ls())
#==========Start==============
#==========基础操作===========
unique()  #去重
duplicated()  #删除重复值
getwd()   #获取当前路径dirname(parent.frame(2)$ofile)  #获取当前执行R文件所在目录#==========生成序列=========
x<-1:10
rep(1:4, c(2,1,2,1))
rep(1:4, each = 2, len = 4)
rep(1:4, each = 1, times = 3)
rep(1:4,c(1,2,3,4))
seq(1,9,by = 1)
paste(c('a','b','c'),rep(1:3,rep(3,3)),sep = "")
rep(1:3,each=3,times=2)
a=c("a","b","C");b=1:3;c=1:2
expand.grid(a,b,c)
#==========R中''和""的区别=============
"'"
'"'
'\"'
#==========生成随机数===========
runif(5)
rnorm(4,2.5)
rnorm(10)   #生成的随机数，符合mean=0,sd=0的标准均差
runif(10,-5,1)  #随机生成器
sample(-5:1,size=10,replace = T)  #随机抽样
#==========head和tail==============
a<-1:10
head(a,1)
tail(a,1)
#==========replace==========
set.seed(123)
base=c('a','t','c','g')
n=30
dna=sample(base,n,T,c(0.2,0.2,0.3,0.3))
dna=paste(dna,collapse = '')
rna=chartr('t','u',dna)#==========利用Which %in%求交集=========
A<-data.frame(name=c("Devin","Edward","Lulu","Jeneen"),age=c(30,33,29,32),score=c(95,99,90,88),class=c(1,2,1,2),gender=c("M","M","F","F")
)
A
if(which("class"%in%cn)){match(c("class","score"),cn)
}
which(cn%in%c("class","score"))
B=apply(A,2,function(x){as.factor(x)})
B
#=========开三次方================
a=c(1,2,-1,4)
b=as.matrix(a)
b^(1/3)
x=b
abs(x)^(1/3)*sign(x)
#==========笛卡尔积==========
a=c(2014,2015)
b=c(1:12)
outer(paste(a,'年',sep=''),paste(b,'月',sep=''),paste,sep="")
paste(outer(a,b,paste,sep="年"),'月',sep="")
#==========Base:assign、Eval摘除子变量==============
dat<-seq(1,25,by=1)
dat<-matrix(dat,5,5)
for (i in 1:5){assign(paste("data",i,sep=""),dat[,i])
}for(i in 1:2){eval(parse(text=paste("t","_",i,"=mtcars[seq(24*i-23,24*i),]",sep="")))
}
eval(parse(text = "c(1,2)"))x1<-1:3;x2=2:5;x3=12:20
for(i in 1:3){eval(parse(text=paste("x",i,"=sum(x",i,"^2)",sep="")))
}
for(i in c("x1","x2","x3")){assign(paste(i,"new",sep=""),sum(get(i)^2))
}
x1;x2;x3
#=========switch================
require(stats)
centre <- function(x, type) {switch(type,mean = mean(x),median = median(x),trimmed = mean(x, trim = .1))
}
x <- rcauchy(10)
centre(x, "median")gender <- sample(c('F','M','Unknow'), size = 100000, replace = TRUE)
gender3 <- factor(gender, levels = c('F','M','Unknow'))  #自定义switch函数返回值
s <- function(case) switch(case,'Female','Male','Unknow')
system.time(gender4 <- sapply(as.numeric(gender3),s))X=c('F','M','Unknow')
switch (X,'Female','Male','Unknow')ccc <- c("b","QQ","a","A","bb")
# note: cat() produces no output for NULL
for(ch in ccc)cat(ch,":", switch(EXPR = ch, a = 1, b = 2:3), "\n")
for(ch in ccc)cat(ch,":", switch(EXPR = ch, a =, A = 1, b = 2:3, "Otherwise: last"),"\n")
#=========within==============
score<-round(runif(100000,min=40,max=92))
system.time(score<-within(data.frame(score),{score4<-''score4[score<60]<-'不及格'score4[score>=60&score<80]<-'合格'score4[score>=80]<-'优秀'
}))
score
#=========列转factor=================
transpose_A<-function(x){t=as.factor(A[,x])t=as.data.frame(t)colnames(t)<-xreturn(t)
}
A<-data.frame(name=c("Devin","Edward","Lulu","Jeneen"),age=c(30,33,29,32),score=c(95,99,90,88),class=c(1,2,1,2),gender=c("M","M","F","F")
)
cn=colnames(A)
B=sapply(list(cn)[[1]],transpose_A)
str(as.data.frame(B))#==========创建空数据框=====
data=data.frame(matrix(NA,3,4))
data
data$X1=c(1:3)
data$X2=c(2:4)
data
#==========数据框操作========
#数据框赋值
b<-data.frame('a',1,2,3,4);b
t<-c("a","b","c")
w<-"001"
tw<-data.frame(x=paste(t,sep="",collapse = ","),y=w);tw
paste(t,sep="",collapse = ",")
#==========删除指定条件行=====
dat<-data.frame("x"=c(1,2,3),"y"=c(11,12,13),"z"=c(111,222,333))
dat
dat[which(!dat$x%in%c(1,3)),]
dat[-which(dat$x%in%c(1,3)),]
subset(dat,!dat$x%in%c(1,3))split(dat,dat$x) #分组
#==========求行平均===========
dat<-data.frame('星期1'=c(1,2,3,4,5),'星期2'=c(2,3,4,5,6)
)
row.names(dat)<-c('a','b','c','d','e')
datrowMeans(dat[1,])
apply(dat, 1, mean)dat
rowSums(dat)
#==========求行汇总===========
require(stats)x <- matrix(runif(100), ncol = 5)
group <- sample(1:8, 20, TRUE)
(xsum <- rowsum(x, group))
## Slower versions
tapply(x, list(group[row(x)], col(x)), sum)
t(sapply(split(as.data.frame(x), group), colSums))
aggregate(x, list(group), sum)[-1]dat<-data.frame('星期1'=c(1,2,3,4,5),'星期2'=c(2,NA,5,6,NA)
)
dat
s<-list()
length(s)<-nrow(dat)
for (i in 1:nrow(dat)){# s[i]<-sum(dat[i,],na.rm = T)  dat$a[i]<-i
}
dat
unlist(s)
#==========累计求和方法============
A<-c(1,2,3,4)
B<-c("a","b","c","c")
temp<-tapply(A,B,cumsum)
tempt=data.frame(name=c("b","a","b","a","a"),fenshu=1:5);t
new=data.frame(t[order(t[,1]),],p=unlist(tapply(t[,2],t[,1],cumsum)))
newinstall.packages("data.table")
require(data.table)
t=data.table(name=c("b","b","b","a","a"),fenshu=1:5)
t[,cumsum(fenshu),by=name]
#==========数据框合并_merge=====================
ID1<-c(1,2,3,4)
name<-c("Jim","Tony","Lisa","Tom")
ID2<-c(3,1,2,4)
score<-c(89,22,78,78)student1<-data.frame(ID1,name)
student2<-data.frame(ID2,score)
total_student<-merge(student1,student2,by.x = "ID1",by.y="ID2")
total_student
#==========合并：tapply========
b<-c(rep(c("A","B","C","D"),2),"A","B");
c<-2:11
dg<-data.frame(b,c)
tapply(dg$c,dg$b,print)
#==========合并：dplyr===============
#install.packages("dplyr")
#install.packages("tidyr")
library(reshape2)
library(dplyr)
library(Matrix)
library(arules)
b<-c(rep(c("A","B","C","D"),2),"A","B")
c<-2:11
dg<-data.frame(b,c)
dg
dg[,'b']
as(split(dg$b,dg$c),"transactions")dg
df<-dg%>%group_by(b)%>%dplyr::summarize(c=paste(c,collapse = ","))
df
apply(df,2,function(x){unlist(strsplit(x,","))})tapply(dg$c,dg$b,print)
tapply(dg$c,dg$b,function(x){paste(x,sep="",collapse = ",")})
#==========三种方式实现类数据透视表功能===================
a<-c(rep("F",3),rep("E",3),rep("G",3))
b<-c(rep(c("A","B","C"),3))
c<-2:10
dg<-data.frame(a,b,c)
dg#tapply
dg$a=as.factor(dg$a)
dg$b=as.factor(dg$b)
tapply(dg$c,list(dg$b,dg$a),sum)
# tapply(dg$c,list(dg$b,dg$a),print)#spread
library(tidyr)
spread(dg,a,c)#recast
library(reshape2)
recast(dg,b~a)#示例
transet=data.frame(a=paste("mac",rep(1:3,each=3),sep = ""),b=rep(c("性别","年龄","教育水平"),3),c=c("女","28","硕士","男","33","博士","男","24","本科")
)
transet
spread(transet,b,c)
dcast(transet, a~b, value.var = 'c')
#==========transform============
library(plyr)
library(ggplot2)
# 使用stringsAsFactors=F来防止data.frame把向量转为factor
apache = data.frame(httpCode=c(200,200,200,404,404,500),time=c(100,111,210,10,10,500),api=c('index','index','logout','show','show','index'),stringsAsFactors=F)
head(apache)
ddply(apache,.(api),summarize,number=length(api))
a<-ddply(apache,.(api,httpCode),summarize,number=length(api))
b <- ddply(a,.(),.fun=function(x){transform(x, percentage=with(x,ave(number,api,FUN=sum)/sum(number)))})
ggplot(b,aes(x=reorder(api,percentage),y=percentage,fill=factor(httpCode))) +geom_bar() +scale_y_continuous(labels = percent_format()) +coord_flip() #==========重复数据处理========
#提取重复数据
x <- rep(c("A", "B"), each = 5)
y <- c(110,110,111,112,111,113,114,114,115,113)
z <- c(1,2,1,1,1,1,1,2,1,1)
dat <- data.frame(x=x, y=y, z=z)
dat
cumsum(rle(dat$y)$lengths)
dat[-cumsum(rle(dat$y)$lengths), ]
dat[which(diff(dat$y)==0),]#提取重复数据
#方法1
abc <- data.frame(x=c(1,2,1,3,3),y=c(1,3,1,0,0));abc
abc
t=abc[duplicated(abc),];t
merge(abc,t,all = F)
#方法2
library(sqldf)
#重复数据
sql='select * from abc where x in (select x from abc group by x having(count(1)>1))'
sqldf(sql)
#多余的重复数据
sql='select * from abc where x not in (select max(x) from abc group by x having(count(1)>1))'
sqldf(sql)dat=data.frame(x=c(1,3,4),y=c(3,1,5))
# library(dplyr)
library(plyr)
tt=apply(dat,1,function(x){x[rank(x)]})
tt=t(tt);tt
tt[-duplicated(as.data.frame(tt)),]#==========重复内容求和===========
dat=data.frame(a=c(rep("A",2),rep("B",3)),b=1:5,c=2:6,d=3:7)
dat
which.min(dat$b)
min(dat$b)
library(dplyr)
group_by(dat,a)%>%summarise(min(b))tapply(dat$b, dat$a, min)#==========创建空列表===========
lst=list()
length(lst)=10#示例
data=list()
length(data)<-10
for (i in 1:10){data[[i]]<-c(1:i)
}
data
#==========列表删除某一元素============
a=list(a=c(1,2,3),b=NULL)
a$c=c(1,2)
a$b=NULL
#==========列表：生成指定============
#列表1
cv=function(x,Z=10,seed=888){Z=Zt1=rep(1:Z,ceiling(x/Z))[1:x]set.seed(seed)t2=sample(t1,x)mm=list()for(i in 1:Z){mm[[i]]=(1:x)[t1==i]}return(mm)
}
tt=cv(100)#列表2
cv1=function(n,Z=10,seed=1){z=rep(1:Z,ceiling(n/Z))[1:n]set.seed(seed)z=sample(z,n)mm=list()for(i in 1:Z){mm[[i]]=(1:n)[z==i]}return(mm)
}
cv1(100)#==========生成滞后一项========
a = c(1,2,3,4,5)
b = lag(a)#==========生成二维序列=========
a<-c("a","b","c")
b<-1:2
c<-1:3
list(a=a,b=b,c=c)
dt<-expand.grid(a,b,c)
apply(dt,1, function(x){paste(x,sep="",collapse = "")})
library(help = "base")#==========时间操作============
library(lubridate)  #时间日期包
library(chron)
#数值转时间
as.Date("20150807","%Y%m%d")
d<-42570
as.Date(d,origin="1900-01-01")
today()
now()
as.Date(now(),"%Y%m%d")dtimes = c("2002-06-09 12:45:40","2003-01-29 09:30:40",
"2002-09-04 16:45:40","2002-11-13 20:00:40",
"2002-07-07 17:30:40")
dtimes
dtparts = t(as.data.frame(strsplit(dtimes,' ')))
row.names(dtparts) = NULL
thetimes = chron(dates=dtparts[,1],times=dtparts[,2],format=c('y-m-d','h:m:s'))
thetimesdts = c("2005-10-21 18:47:22","2005-12-24 16:39:58","2005-10-28 07:30:05 PDT")
as.POSIXlt(dts)dts = c(1127056501,1104295502,1129233601,1113547501,1119826801,1132519502,1125298801,1113289201)
mydates = dts
class(mydates) = c('POSIXt','POSIXct')
mydatesmydate = strptime('16/Oct/2005:07:51:00',format='%d/%b/%Y:%H:%M:%S')
ISOdate(2005,10,21,18,47,22,tz="PDT")
thedate = ISOdate(2005,10,21,18,47,22,tz="PDT")
format(thedate,'%A, %B %d, %Y %H:%M:%S')
mydate = as.POSIXlt('2005-4-19 7:01:00')
names(mydate)
mydate$mday
#==========时间周期_lubridate包=====================
# install.packages("lubridate")
today=Sys.time()
format(Sys.Date(),"%U")
#==========时间差计算_difftime=================
d <- c('2013-12-05 18:43:00','2013-08-23 22:29:00')
difftime(d[2],d[1])
strptime(d, "%Y-%m-%d %H:%M:%S")
difftime(strptime(d, "%Y-%m-%d %H:%M:%S")[2],strptime(d, "%Y-%m-%d %H:%M:%S")[1])
difftime(strptime(d, "%Y-%m-%d %H:%M:%S")[2],strptime(d, "%Y-%m-%d %H:%M:%S")[1],units='secs')#==========查看源代码============
library(arules)
getAnywhere(apriori)
fix(apriori)
#==========查看帮助文档_vignette=======
vignette("grid")  #查看小文品#==========读入文件============
getwd()
choose.dir()
list.files()#csv
read.csv()
fread()#txt
read.table()
readLines() #读入不规则文本#SPSS
library(foreign)
dat<-read.spss("~/huigui.sav")#xlsm
library(xlsx)
read.xlsx()#readxl
library(readxl)
read_excel()#RODBC
RODBC::odbcConnectExcel2007()
#==========写出=======
write.csv()
write.table()#保存图片
file()
#==========输出中换行================
paste("a","b",collapse = " ",sep="")
cat(c("ab","\n","\nb"))
plot(1,ylab=expression(italic("toto")["subscript"]),xlab=expression(italic("toto")^"subscript"))
text<-c(substr("你是最优秀的",1,nchar("你是最优秀的")/2),"\n",paste('\n',substr("你是最优秀的",nchar("你是最优秀的")/2+1,nchar("你是最优秀的")),sep='')
)
cat(text)#==========文件夹系统============
# 当前的目录
getwd()
# 查看当前目录的子目录
list.dirs()#查看当前目录的子目录和文件
dir()
# 查看指定目录的子目录和文件。
dir(path="./figure/")
#==========文件操作_file=============
path = 'J:/lab/EX29 --在R语言中进行文件（夹）操作'
setwd(path)
cat("file A\n", file="A") #创建一个文件A，文件内容是'file A','\n'表示换行，这是一个很好的习惯
cat("file B\n", file="B")  #创建一个文件B
file.append("A", "B")  #将文件B的内容附到A内容的后面，注意没有空行
file.create("A")  #创建一个文件ZWZA, 注意会覆盖原来的文件
file.append("A", rep("B", 10)) #将文件B的内容复制10便，并先后附到文件A内容后
file.show("A")  #新开工作窗口显示文件A的内容
file.copy("A", "C") #复制文件A保存为C文件，同一个文件夹
dir.create("tmp")  #创建名为tmp的文件夹
file.copy(c("A", "B"), "tmp") #将文件夹拷贝到tmp文件夹中
list.files("tmp")  #查看文件夹tmp中的文件名
unlink("tmp", recursive=F) #如果文件夹tmp为空，删除文件夹tmp
unlink("tmp", recursive=TRUE) #删除文件夹tmp，如果其中有文件一并删除
file.remove("A", "B", "C")  #移除三个文件
file.rename(from = ,to = )
#==========文件清单之list.files===========
files<-list.files()
files
split(files,"")
as.data.frame(files)files<-getSampleFiles()#==========reshape包：melt==============
library(reshape)
a<-c(rep(2007,4),rep(2008,3),rep(2009,3));a
b<-c(rep(c("A","M","F","D"),2),"A","B");b
c<-2:11de<-data.frame(a,b,c)
#对应的包是cast
cast(de,a~b)
melt(de,id="b")chisq.test(c(335, 125, 160), p=c(9,3,4)/16)
help(chisq.test)
chisq.test(rbind(c(335, 125, 160), c(9,3,4)*sum(335, 125, 160)/16))
rbind(c(335, 125, 160), c(9,3,4)*sum(335, 125, 160)/16)
#==========reshape包：melt、dcast、acast==============
library(reshape2)
tes<-data.frame(x=rep(c("A","B","C","D"),c(6,6,6,6)),y=1:24)
tes
unstack(tes,y~x)
#reshape常用方法：melt、dcast、acastlibrary(reshape2)
library(reshape)
ID=1:8
md<-data.frame(ID=rep(1:4,c(2,2,2,2)),Ti=rep(1:2,4),Td=paste("X",rep(1:2,c(4,4)),sep=""),Val=1:8)
cast(md,ID~Td)
dcast(md,ID~Td,mean)
#==========melt多列揉两列=================
library(dplyr)
library(reshape)
library(xlsx)
library(readxl)rm(list = ls())dat=read_excel('~/R日常数据集/多列揉两列/Cost.xlsx',sheet= 2)
colnames(dat)[2]="省份"
colnames(dat)[3:ncol(dat)]=paste("x",colnames(dat)[3:ncol(dat)],sep="")attributes(dat)
str(dat)
head(dat)
dg=transform(dat,fq=c(1:nrow(dat)))
dt=melt(dg,id.vars = c("类别","省份"))#e.g
head(melt(tips))
names(airquality) <- tolower(names(airquality))
melt(airquality, id=c("month", "day"))
names(ChickWeight) <- tolower(names(ChickWeight))
melt(ChickWeight, id=2:4)#==========plot画布============
par(mfrow=c(2,3)) #设置画布,2行3列
mat=matrix(c(1:4,5,5),nrow=3,byrow = T)
mat
layout(mat) #对图形装置（device）按照矩阵进行分割usr <- par("usr") #获取坐标
#==========par参数设置==========
par(mar=c(5,3,2,2))
# c(bottom, left, top, right)，mar是图形上下左右边缘距离
par(mai=c(2,1,2,2))
# c(bottom, left, top, right)，mai是图形空白边界
par(mgp=c(3,1,0))
# c(title,axis,axis_label)，mpg是针对坐标轴标题、坐标轴标签和坐标轴
par(tck=0.01)
# 其中tck，是刻度线正反向。
opar <- par(no.readonly=TRUE)
# 保存原有的设置
par(lty=2,pch=3,lwd=3,pty)
#lty:line type 线类型;pch：pie 绘制符号类型；lwd:line width 线宽；pty:绘图区域类型#==========plot示例1==========
windowsFonts(H=windowsFont('华文行楷'))
windows(width=5,height=5)
par(mar=rep(0,4)+0.1)
plot(1,type = 'n',ann=F,axes=F,xlim=0:1,ylim=0:1)
text(0.25,0.80,'test',family='H',cex=5,xpd=T)
text(0.6,1,'test',family='H',cex=5,xpd=T)
text(0.45,0.75,'ppp',family='H',cex=6,xpd=T)
#==========plot相关============x1<-1:1000
#常规画图
plot(x1,x1^(1/3),type="l",lty=2,lwd=3)
#lty点之间的间隔；lwd线条宽度
#不画X轴
plot(x1,x1^(1/3),type="l",lty=2,lwd=2,xaxt="n")
axis(side = 1,at = c(1,100,900))axis(side=1,at=c(1,100,900),labels=c(1,9,10))points(x1,x1^(1/2.5),type="l",lty=1,lwd=3)points(x1[1:200],x1[1:200]^(1/2.5),type="l",lty=1,lwd=3)c<-c(7,15,36,39,40,41,50)
quantile(c)
boxplot(quantile(c))library(rJava)
library(xlsx)
#==========plot绘图案例1============
weight = c(115,117,120,123,126,129,132,135,139,142,146,150,154,159,164)
height = c(58,59,60,61,62,63,64,65,66,67,68,69,70,71,72)
fit2 = lm(weight~height+I(height^2))
plot(height,weight,'p')
points(60,125)
text(60,125,labels = "2000")
abline(fit2)
summary(fit2)as.POSIXct("2015-1-1")#==========plot背景
transet=data.frame(year=c(2000+2:15),poi=runif(14,50,100)
)
plot(transet$year,transet$poi,type = "p",)
lines(transet$year,transet$poi)#==========ggplot======================
#ggplot在应用facet时，标题在图形居中显示
#方法：theme中plot.title=element_text(hjust=0,5)library(ggplot2)
#散点图
d <- ggplot(diamonds, aes(carat)) + xlim(0, 3)
d + stat_bin(aes(ymax = ..count..), binwidth = 0.1, geom = "area")
d + stat_bin(aes(size = ..density..), binwidth = 0.1,geom = "point", position="identity"
)
d + stat_bin(aes(y = 1, fill = ..count..), binwidth = 0.1,geom = 'tile', position='identity'
)#柱状图
library(ggplot2)
PV <- c("湖南","湖北","山西")
GDP <- c(6,8,15)
mydata <- data.frame(PV=PV,GDP=GDP)
ggplot(mydata,aes(x=PV,GDP))+geom_bar(stat = "identity")#直方图
rm(list=ls())
set.seed(seed = 1)
data=rnorm(100)*2+6
layout(matrix(c(1,2),1),widths = c(5,1))
par(mar=c(4,5,4,0),mgp=c(2.5,0.8,0))
p=hist(data,col='white',xaxt='n',yaxt='n',border='white',breaks=20,xlab = '',ylab = '',main='')
cs=p$counts/max(p$counts)
breaks=round(seq(0,max(p$counts),len=6)[-6])
red=cs
green=1-cs
blue=0
par(new=T)
hist(data,col=rgb(red,green,blue),breaks = 20,yaxt='n',border='white',ylab='count',main='')
axis(2,las=2)
par(mar=c(8,0,8,3.3),mgp=c(2.5,0,0.2))
color2=rgb(seq(0,1,len=length(breaks)),seq(1,0,len=length(breaks)),0)
image(x=1,y=0:length(breaks),z=t(matrix(breaks))*1.001,col=color2,axes=F,xlab='')
mtext(side=3,line=0,'count')
axis(4,at=1:length(breaks)-1,labels = breaks,las=2,col='white')
#==========ggplot设置Scale刻度================
library(ggplot2)
data(diamonds)
head(diamonds)
set.seed(42)
dat=diamonds[sample(nrow(diamonds),1000),]
head(dat)
p=ggplot(diamonds,aes(carat,price,shape=cut,colors=cut))
p=p+geom_point()
p
#scale_shape_manual()、scale_colour_hue()
bks<-c(0, 2000, 4000,6000, 8000, 10000)
p + scale_x_continuous("price", breaks = bks, labels = bks)
#==========ggplot之density用法=============
mydat<-read.table("~./mydat.txt",header = T)
head(mydat)
mydat[1:100,]
mydat<-na.omit(mydat)
density(mydat[1:61487,])p<-ggplot(mydat)
p+geom_density(aes(x=x,y=..count../sum(..count..)))p=ggplot(mydat)
p+geom_density(aes(x=x,y = ..density..))p=ggplot(mydat)
p+geom_density(aes(x=x,y = ..scaled..))p=ggplot(mydat)
p+geom_histogram(aes(x=x,y = ..ndensity..))plot(density(c(-20, rep(0,98), 20)), xlim = c(-4, 4))  # IQR = 0
c(-20, rep(0,98), 20)
density(c(-20, rep(0,98), 20))chr="sample.file=sample.txt"
str(chr)
arg=unlist(strsplit(chr,"="));arg
paste(arg[1],arg[2],sep = "=====",collapse = "")ss<-c("asdf_dfgh_sd")
ss<-strsplit(ss,"_")
unlist(ss)paste(1,2,sep = "===")
#==========ggplot多图=================
library(gridExtra)
grid.arrange(x,y,nrow=2,ncol=1)
#==========ggplot_坐标轴反转=================
# install.packages("cowplot")
library(reshape2)
library(reshape)
library(ggplot2)
library(cowplot)dat=read.csv("~/aa.csv",header = T)
head(dat)
New_dat<-melt(data = dat,id=c('TARGET'))
head(New_dat)
p=ggplot(data=New_dat,mapping = aes(x=TARGET,y=variable,fill=value))
p=p+geom_tile()
#ggdraw中switch_axis_position可以选择坐标轴
ggdraw(switch_axis_position(p + theme_gray(), axis = 'y'))
ggdraw(switch_axis_position(p + theme_gray(), axis = 'xy',keep = "xy"))
p+geom_raster()
#==========gridExtra包=============
# install.packages("gridExtra")
library(gridExtra)
#==========grid包：曲线绘制在一个页面===========
grid.newpage() ##新建页面
pushViewport(viewport(layout = grid.layout(length(st_name),1)))
vplayout <- function(x,y){viewport(layout.pos.row = x, layout.pos.col = y)
}
#==========plotrix:====================
# x-values
x <- 1:4
# small y-values with corresponding standard errors
meansarr <- c(14.9, 18.2, 14.5, 18.3)
searr <- c(0.47, 1.27, 1.22, 0.49)
# large values
meanslay <- c(36.4, 39.0, 35.3, 38.6)
selay <- c(0.51, 0.34, 0.57, 0.40)
library(plotrix)
# plot small values
plot(x, meansarr, ylim=c(12, 30), axes=F, type="b", xlab="", ylab="Day")
arrows(x, meansarr-searr, x, meansarr+searr, code = 3, angle = 90,length = 0.03)
box()
# x-axis
axis(1, tck=0.01, las=1, at=1:4,labels=c("1998", "1999", "2002", "2003"), mgp=c(3, 0.5, 0))
# y-axis
axis(2,at=c(12, 14, 16, 18, 20, 24, 26, 28,30),labels=c("12","14","16","18","20", "34","36","38","40"))
# break axis
axis.break(2, 22, style="zigzag")
# add large values to same plot
par(new=TRUE)
plot(x, meanslay, ylim=c(30, 40), type="b", xlab="", ylab="Day", axes=F)
arrows(x, meanslay-selay, x, meanslay+selay, code = 3, angle = 90,length = 0.03)
#==========eqscplot绘制垂直误差线==============
library(MASS)
X <- scale(mvrnorm(20, c(2,2), matrix(c(1,0.5,0.5,1),2,2)))
eqscplot(X)
X.cov <- cov(X)
X.ed <- eigen(X.cov)
proj <- X.ed$vec[,1] %*% t(X.ed$vec[,1])
y <- t(proj %*% t(X))
abline(a=0,b=X.ed$vec[2,1]/X.ed$vec[1,1])
arrows( X[,1], X[,2], y[,1],y[,2], length = 0.05, col = "blue")
#==========ggplot2案例1====================
library(ggplot2)
date <- c("2011-09-19","2011-09-20","2011-09-21","2011-09-22","2011-09-23","2011-09-26","2011-09-27")
price <- c(100,110,105,115,120,115,125)
tmp <- data.frame(date,price)
head(tmp,3)
tmp$date <- as.Date(tmp$date)
p <- ggplot(tmp,aes(tmp$date,tmp$price))+geom_line()
p+labs(title="Simple price plot",x="Date",y="Price")
p+xlab('时间')
#==========ggplot绘多条折线图之melt转换数据==================
library(ggplot2)
library(reshape)p <- ggplot(mtcars, aes(x = wt, y = mpg)) + geom_point()
p + geom_vline(aes(xintercept = wt))library(ggplot2)
library(reshape)
test_data <- data.frame( var0 = 100 + c(0, cumsum(runif(49, -20, 20))), var1 = 150 + c(0, cumsum(runif(49, -10, 10))), date = seq.Date(as.Date("2002-01-01"), by="1 month", length.out=100))
test_data
test_data_long <- melt(test_data, id="date") # convert to long format
#test_data_longggplot(data=test_data_long, aes(x=date, y=value, colour=variable)) + geom_line()
rm(list = ls())
#==========plotly：ggplotly交互图============
install.packages("plotly")
library(plotly)
ggplotly#==========绘制中国地图_plot======================
#got the london_sport.shx and london_sport.dbf files in the same folder?
#You need all three to make a "Shapefile".
par(mar=c(0,0,0,0)+0.1,xpd=TRUE)
library(maptools)
x=readShapePoly('C:/Users/zhengweilin/Documents/中国地图GIS数据/maps/bou2/bou2_4p.shp')
x=readShapePoly('C:/Users/zhengweilin/Documents/bou2_4p.shp')
x=readShapePoly('C:/Users/zhengweilin/Documents/中国地图GIS数据/maps/bou2/bou2.shp')
getColor=function(mapdata,provname,provcol,othercol)
{f=function(x,y) ifelse(x %in% y,which(y==x),0)colIndex=sapply(mapdata@data$NAME,f,provname)fg=c(othercol,provcol)[colIndex+1]return(fg)
}provname=c("北京市","天津市","上海市","重庆市")
provcol=c("red","green","yellow","purple")
plot(x,col=getColor(x,provname,provcol,"white"))
#==========Github和baidumap=============
# install.packages("devtools")
library(devtools)
# install_github('badbye/baidumap')
# install_github('lchiffon/REmap')
library(REmap)library(baidumap)
getCoordinate('北京大学') # json
getCoordinate('北京大学', output='xml') # xml
getCoordinate('北京大学', formatted = T) # character
getCoordinate(c('北京大学', '清华大学'), formatted = T) # matrix
p<-getBaiduMap(c(116.354431,39.942333))#绘制百度地图
library(ggmap)
ggmap(p)#==========文本处理之substring==============
a<-"world"
paste(unlist(strsplit(a,""))[1:3],sep="",collapse = "")
substring(a,c(2))
#==========文本处理之strsplit用法===============
sa<-c("1234512","1234567")
sd<-as.data.frame(strsplit(sa,""))
colnames(sd)<-c("a","b")
se<-merge(sd[6:7,1],sd[7:6,2])
paste(se$x,se$y,sep="",collapse = " ")c<-"hello world"
data.frame(unlist(strsplit(c,"\\n")))
#==========stringr的分割线========
#在R中关于反斜杠\的替代处理办法
library(stringr)
a<-"aaa111\\\\aa\\\aaa\a"
a<-"a\aab\\c\\d\\e"
b<-gsub("[^[:graph:]]","",a);b
gsub("\\", '', b, fixed=TRUE)gsub("\\\\","", a)a<-str_replace_all(a,"([\\])","")
str_replace_all(a,"([\\])","")strsplit(a,"\\\\")gsub("\\", "", a, fixed=TRUE)
gregexpr("([\\])",a)
gsub("Hmisc::escapeRegex","",a)
gsub("Hmisc::escapeBS","",a)
gsub("([\\])","", "C:\subfolder")
#==========stringr练习1========
library(stringr)t=as.character(Sys.time());t
strsplit(t,"\\s")
??rainbow()
#==========stringr练习2========
strings <- c(" 219 733 8965", "329-293-8753 ", "banana", "595 794 7569","387 287 6718", "apple", "233.398.9187  ", "482 952 3315","239 923 8115 and 842 566 4692", "Work: 579-499-7527", "$1000","Home: 543.355.3679")
phone <- "([2-9][0-9]{2})[- .]([0-9]{3})[- .]([0-9]{4})"
str_extract(strings, phone)
str_match(strings, phone)
# Extract/match all
str_extract_all(strings, phone)
str_match_all(strings, phone)
#==========str_extract_all提取正则匹配========
library(stringr)
shopping_list <- c("apples x4", "bag of flour", "bag of sugar", "milk x2")
str_extract(shopping_list, "\\d")
#==========字符串内字符频率统计============
abc<-"abc,abca"
#strsplit计算分段数
t<-strsplit(abc,"a")
length(t)
#stringr频率统计
library(stringr)
str_count(abc,"a")
#正则
attr(gregexpr("a",abc)[[1]],"match.length")a <- "aggcacggaaaaacgggaataacggaggaggacttggcacggcattacacggagg"
regexpr("ag",a)
gregexpr("ag",a)
gregexpr("a.g",a)
attr(gregexpr("a.g",a)[[1]], "match.length")   #提取子模式长度#==========正则_Grep==========
test<-c("one","long","oner","dead")
test[grep('[on]',test)]
test[grep('[on|ed]',test)]
grep('[on|ed]',test,value=T)
#value=T返回字符、invert表示反选
grep("o",test,value = T,invert =F)
gregexpr('o|n',test)
regmatches(test,gregexpr('o|n',test))gregexpr("o","zoo")one<-1
get(grep("^one$",test,value=T))
one<-10000
get(grep("^one$",test,value=T))st<-"s123456"
sr<-paste(unlist(regmatches(st,gregexpr('\\d',st))),collapse = "")substr("Abcd",2,2)
substring("abcdef", 1:6, 1:6)
x <- c("asfef", "qwerty", "yuiop[", "b", "stuff.blah.yech")
substring(x, 1, 5:6)
substr(x, 2, 5:6)
substring(x, 2) <- c("..", "+++")
x#练习001
f="1-2-(234).xls"
gregexpr('\\((\\d.+)\\)',f)
regmatches(f,gregexpr('\\((\\d.+)\\)',f))
#==========正则_取子表达式=============
# 正则取子表达式
x="time=13422&cardid=23323&cyberzone=wefa"# t1=regexpr('cardid=(\\d*?)&',x,perl = T)
# t2=gregexpr('cardid=(\\d*?)&',x,perl = T)
t3=regexec('cardid=(\\d*?)&',x)
substr(x,t3[[1]][2],t3[[1]][2]+attr(t3[[1]],"match.length")[2]-1)regexec('time=(\\d*?)&cardid=(\\d*?)&',x)
#==========数据清洗_取指定条件================
subset(da,da$province %in% c("A","B") ) da$province[grep("A|B",da$province)]#==========Plyr_arrange排序=======================
dat<-data.frame(a=rep(c(1,2),3),b=rnorm(6))
dat$b
b1<-sort(dat$b,decreasing = T)
b1
dat[order(dat$b,decreasing = F),]
table(dat$a,dat$b)dat[c(2,6,4),]library(base)
library(plyr)
arrange(dat,desc(b))#==========dplyr_分组取Top5的值=========
dat=data.frame(a=c(rep("A",5),rep("B",3)),b=runif(8,1,10))
datlibrary(dplyr)group_by(dat,a)%>%top_n(3)#min_rank相关
x <- c(5, 1, 3, 2, 2, NA)
row_number(x)
min_rank(x)
dense_rank(x)
percent_rank(x)
cume_dist(x)
#==========dplyr：group_by==============
library(dplyr)
b<-c(rep(c("A","B","C","D"),2),"A","B");
c<-2:11
d<-3:12
dg<-data.frame(b,c,d)
gb<-group_by(dg,b)
gb
summarise(gb,c=paste(c,collapse = ","))
summarise(gb,d=sum(d))
#==========合并：tapply========
b<-c(rep(c("A","B","C","D"),2),"A","B");
c<-2:11
dg<-data.frame(b,c)
tapply(dg$c,dg$b,print)
#==========合并：dplyr===============
#install.packages("dplyr")
#install.packages("tidyr")
library(reshape2)
library(dplyr)
library(Matrix)
library(arules)
b<-c(rep(c("A","B","C","D"),2),"A","B")
c<-2:11
dg<-data.frame(b,c)
dg[,'b']
as(split(dg$b,dg$c),"transactions")dg
df<-dg%>%group_by(b)%>%dplyr::summarize(c=paste(c,collapse = ","))
df
apply(df,2,function(x){unlist(strsplit(x,","))})tapply(dg$c,dg$b,print)
tapply(dg$c,dg$b,function(x){paste(x,sep="",collapse = ",")})
#==========tidyr:拆分===================
library(tidyr)
df
df%>%group_by(b)%>%transform(c= strsplit(c, ","))%>%unnest(c)#==========tapply用法===============
a<-c(rep(2007,4),rep(2008,3),rep(2009,3));a
b<-c(rep(c("A","B","C","D"),2),"A","B");b
c<-2:11
da<-as.data.frame(cbind(a,b,c))
colnames(da)<-c("year","province","sale")#attach连接数据框、detach释放
attach(da)
attributes(da)
factor(province)
aa<-list(year,province)tapply(sale,province)
tapply(sale,year)
# ??tapply
tapply(sale,list(year,province))
tapply(sale,list(year,province),mean)
detach(da)#官方示例
ind <- list(c(1, 2, 2), c("A", "A", "B"))
table(ind)
ind
tapply(1:3, ind) #-> the split vector
tapply(1:3, ind, sum)
#==========tapply_合并========
b<-c(rep(c("A","B","C","D"),2),"A","B");
c<-2:11
dg<-data.frame(b,c)
dg$c=as.factor(dg$c)
tapply(dg$c,dg$b,print)
tapply(dg$c,dg$b,paste)
tapply(dg$c,dg$b,function(x){paste(x,sep="",collapse = ",")})
#==========dplyr：unite\tidyr：separate==============
library(dplyr)
library(tidyr)
unite
unite_(mtcars, "vs_am", c("vs","am"))
# Separate is the complement of unite
mtcars %>%unite(vs_am, vs, am)%>%separate(vs_am, c("vs", "am"))
#==========dplyr：group_by+summarise=====================
head(mtcars)library(dplyr)group_by(mtcars,am)%>%summarise_each(funs(mean))%>%ungrouptt<-group_by(mtcars,am)group_by(mtcars,am)%>%summarise_each(funs(mean))
#==========dplyr：%>%含义=====================library(ggplot2)
library(plyr)
library(dplyr)
library(tidyr)
anscombe_tidy <- anscombe %>%+     mutate(observation = seq_len(n())) %>%+     gather(key, value, -observation) %>%+     separate(key, c("variable", "set"), 1, convert = TRUE) %>%+     mutate(set = c("I", "II", "III", "IV")[set]) %>%+     spread(variable, value)
# 是管道函数啦，就是把左件的值发送给右件的表达式，并作为右件表达式函数的第一个参数。
# anscombe_tidy <- anscombe %>%mutate(observation = seq_len(n()))
# 以上代码等价于
# anscombe_tidy=mutate(anscombe,observation = seq_len(n()))#中国式排名
a=c(0.1,0.2,0.3,0.6,0.7,2,0.3,0.1,0.1)
b=unique(a)
c<-data.frame(a)%>%left_join(data.frame(a=b,d=order(b)),by="a")
c#生成序列
library(dplyr)
x<-1:10
x%>%lapply(function(x) 1:x)%>%unlist
#==========dplyr：sapply===============
z=list(a=c(1:3),b=c(5:6),c=c(7:11))
data.frame(z=rep(names(z),sapply(z,length)), y=unlist(z))z=list(c(1:3),c(5:6),c(7:11))
data.frame(x=rep(c(1:length(z)),sapply(z,length)),y=unlist(z))
#==========dplyr：ddply取分类前三======
library(dplyr)
library(plyr)
tes<-data.frame(x=rep(c("A","B","C","D"),c(6,6,6,6)),y=1:24)
tes
ddply(tes,~x,subset,rank(y)<=3)
#==========dplyr练习====================
library(dplyr)
a=c(0.1,0.2,0.3,0.6,0.7,2,0.3,0.1,0.1)
b=unique(a)
c<-data.frame(a)%>%left_join(data.frame(a=b,d=order(b)),by="a")
c
a<-data.frame(a=a)
c<-data.frame(unique(a),d=order(unique(a)))
merge(c,a,by=c("a"))
left_join(a,c,by="a")tt<-matrix(c(1:12),nrow=3,byrow=T)
t1<-table(tt)
t2<-as.data.frame(t1)
t2$tt=as.numeric(t2$tt)
colnames(t2)<-c("x","y")data.frame(x=tt[,1])%>%left_join(t2,by="x")tt<-matrix(c(1:12),nrow=3,byrow=T)
t1<-table(tt)
t2<-as.data.frame(t1)
t2$tt=as.numeric(t2$tt)
colnames(t2)<-c("x","y")
t3=data.frame(x=tt[,1])
t2[which(t2$x%in%t3$x),]
#==========tidyr:unnest================library(dplyr)
library(tidyr)
#==========pipeR===========
install.packages('pipeR')#==========主成分分析===============
# install.packages("psych")
library(psych)
####主成份分析（Principal Component Analysis，PCA）
####判断主成份个数
fa.parallel(USJudgeRatings[,-1],fa="PC",n.iter=100,show.legend=FALSE,main="Scree plot with parallel analysis")#==========协同过滤推荐算法Apriori:transactions===============
library(arules)
dat=read.table("12.txt")
dat<-unique(dat)
# head(dat)
write.table(dat,"12_1.txt",row.names = F)
data=read.transactions("12_1.txt",format="single",cols=c(1,2))
inspect(data)
#==========transactions================
## example 1: creating transactions form a list[示例1：创建交易，形成一个列表]
a_list <- list(c("a","b","c"),c("a","b"),c("a","b","d"),c("c","e"),c("a","b","d","e")
)
a_list
## set transaction names[＃设置事务名]
names(a_list) <- paste("Tr",c(1:5), sep = "")
a_list
## coerce into transactions[＃强制交易]
trans <- as(a_list, "transactions")
inspect(trans,5)a_df3 <- data.frame(TID = c(1,1,2,2,2,3), item=c("a","b","a","b","c", "b"))
a_df3
trans5<- as(split(a_df3[,"item"], a_df3[,"TID"]), "transactions")
inspect(trans5,1)
#==========聚类============
#关于聚类的练习
#聚类的几种方法：离差平方和、最短距离、最长距离、McQuitty相似分析、中间距离、重心
#hclust，R中的聚类函数
require(graphics)
hc <- hclust(dist(USArrests), "ave")
hc
summary(hc)
plot(hc)
plot(hc, hang = -1)#练习1
x<-c(1,0.846,0.805,0.859,0.473,0.398,0.301,0.382,0.846,1.000,0.881,0.826,0.376,0.326,0.277,0.277,0.805,0.881,1.000,0.807,0.380,0.319,0.237,0.345,0.859,0.826,0.801,1.000,0.436,0.329,0.327,0.365,0.473,0.376,0.380,0.436,1.000,0.762,0.730,0.629,0.398,0.326,0.319,0.329,0.762,1.000,0.583,0.577,0.301,0.277,0.237,0.327,0.730,0.583,1.000,0.539,0.382,0.415,0.345,0.365,0.629,0.577,0.539,1.000)
names<-c("身高","手臂长","上肢长","下肢长","体重","颈围","胸围","胸宽")
r<-matrix(x,nrow=8,dimnames=list(names,names))
d<-as.dist(1-r);hc<-hclust(d);dend<-as.dendrogram(hc)
nP<-list(col=3:2,cex=c(2.0,0.75),pch=21:22,bg=c("light blue","pink"),lab.cex=1.0,lab.col="tomato")
addE<-function(n){if(!is.leaf(n)){attr(n,"edgePar")<-list(p.col="plum")attr(n,"edgetext")<-paste(attr(n,"members"),"members")}n
}
de<-dendrapply(dend,addE)
par(no.readonly = T)
plot(de,nodePar = nP)
#==========arules:discretize离散数据分类===========
library(arules)
??arules
discretize {arules}#==========抽取数据之sqldf=====================
head(de)
library(sqldf)
mydat<-sqldf("select * from de where b='F'",row.names=T)
subset(de,de$b %in% "F")
unlist(de$a[which(de$b=="F")])
de$a[grep("F",de$b)]
#==========分组sqldf方法==============
library(dplyr)
library(sqldf)
a<-data.frame(x=1:5,y=letters[c(rep(1:2,2),1)]);a
tapply(a$x,a$y,max)
aggregate(a$x,by=list(a$y),FUN=max)
sqldf("select y,x from a group by y")
summarise(group_by(a,y),n=max(x))a<-data.frame(x=paste("x",c(1:2,1:3,1:3),sep = ""),y=paste("y",c(1:3,1:5),sep=""),z=1:8);a
b<-tapply(a$z,a$x,max)
b<-aggregate(a$z,by=list(a$x),FUN=max)
a[which(a$x%in%b[,1]&a$z%in%b[,2]),]
rm(a)
rm(b)#==========RODBC_数据库================
library(RODBC)
odbcDataSources()
ds<-odbcConnect("SQL",uid="sa",pwd="weilin")
data(USArrests)
#将“USArrests”表写进数据库里
sqlSave(ds,USArrests,rownames = "state",addPK = T)
#将数据流保存，这时候打开SQL Server就可以看到新建的USArrests表了
rm(USArrests)
#移除USArrests
sqlTables(ds,tableType = "TABLE")
#列出SQL库中的所有表
sqlFetch(ds,"USArrests",rownames = "state")
sqlQuery(ds,"select * from USArrests")sqlDrop(ds,"USArrests")
#输出USArrests表中的内容sqlQuery(ds,"create table Tdat(ID int,Name char(255),School varchar(255))insert into Tdat(ID,Name,School) values(1,'abc',3)d")
sqlQuery(ds,"alter table Tdat alter column School int")
sqlQuery(ds,"drop table Tdat")
sqlQuery(ds,"insert into USArrests(state,Murder,Assault,UrbanPop,Rape) values('ac',1,2,3,100)")attr(USArrests,"names")
head(USArrests)a<-data.frame(state='a',Murder=1,Assault=2,UrbanPop=3,Rape=4);a
a<-data.frame(Murder=1,Assault=2,UrbanPop=3,Rape=4);a
rownames(a)="ac";a
sqlSave(ds,a,'USArrests',append=T)
sqlQuery(ds,"delete from USArrests where state='ac'")odbcClose(ds)
#==========RODBC连接库=============================
library(RODBC)
ds=odbcConnect(dsn = "Supcon",uid = "robotdemo1",pwd = "supcon1304")
table=sqlTables(ds,tableType = "TABLE")
SQL=paste('select * from ','"','Comm_Contract','"',sep = '')
tt=sqlQuery(ds,SQL)
#==========RODBC本地库测试=============
library(RODBC)
ds=odbcConnect(dsn = "SQL",uid = "sa",pwd = "weilin")
#取表清单
tables=sqlTables(ds,tableType='Table')
#查询
sql_1="select * from Rdc"
sqlQuery(ds,sql_1)
#删除表
sql_2="drop table Lagou"
sqlQuery(ds,sql_2)
#创建表
sql_3="create table Lagou (ID int,Name varchar(255))"
sqlQuery(ds,sql_3)#关闭连接
odbcClose(ds)
#==========RODBC_数据库操作示例========
library(RODBC)
conn=odbcConnect("SQL")
odbcTables(conn)
sqlTables(conn,tableType = 'TABLE')
# sqlSave(conn,dat = dat)
# sqlDrop(conn,sqtable = "dat")
sqlUpdate(conn,dat,tablename = "dat")
sqlFetch(conn,"dat")
dat=transform(dat,e=4:8)
#==========RODBC_Excel============
library(RODBC)
z = odbcConnectExcel("C:\\Documents and Settings\\zhengweilin\\My Documents\\MapApply1.xls")
fill1 = sqlFetch(z,"填色")
odbcClose(z)
#==========R数据库_RJDBC================
#DBI
# install.packages("DBI")
# install.packages("RJDBC")
library(DBI)
library(RJDBC)
# require(rJava)if (Sys.getenv("JAVA_HOME")!="") Sys.setenv(JAVA_HOME="")
jcc = JDBC("com.ibm.db2.jcc.DB2Driver", "~/JDBC/JDBC-DB2-jar/db2jcc.jar",identifier.quote = "\"")#连接数据库
drv = JDBC("com.ibm.db2.jcc.DB2Driver","~/JDBC/JDBC-DB2-jar/db2jcc.jar", NA)
conn46 = dbConnect(drv,"jdbc:db2://10.158.130.46:50000/hndcdb","dwinst","hndw&83d")#抽取数据
dbListTables(conn46)
Holiday = dbReadTable(conn46, "DCDW.HOLIDAY" )
Holiday = dbGetQuery (conn46, "select * from DCDW.HOLIDAY")
head(Holiday)#==========XML中reatHTMLTable用法==============
sessionInfo()
library(XML)
txt="http://data.eastmoney.com/stock/lhb/yyb/80357508.html"
#url= htmlParse(txt,encoding = "utf-8")
readLines(txt,encoding = "utf-8")
url=txt
tables=readHTMLTable(url)
medat<-tables$dt_1
head(medat)
str(medat)
tdat<-medat[,8]Encoding(colnames(medat))<-"utf-8"
colnames(medat)
Encoding(tdat)<-"utf-8"
tdat
iconv
#==========RCurl爬虫：debugGatherer==================
library(RCurl)
#加载RCurl包
getKm<-function(x){d=debugGatherer()#设置debugGatherer，响应responsemyHttpheader<-c("User-Agent"="Mozilla/5.0 (Windows NT 6.1; rv:41.0) Gecko/20100101 Firefox/41.0","Accept"="text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8")#设置headers格式，followlocation＝T可以解决重定向的问题。temp<-getURL(paste("http://zh.flightaware.com/live/flight/",x,sep=""),httpheader=myHttpheader,debugfunction=d$update,verbose=T)#获取网页信息temp1<-d$value()[["headerIn"]]url1<-regmatches(temp1,regexpr(pattern = "http:.+Vary",temp1))url2<-unlist(strsplit(url1,"\r"))[1]t=regmatches(url2,regexpr("\\d+{1,}$",url2))t1=as.numeric(t)*1url=paste(unlist(strsplit(url2,t)),t1,sep="")#处理网页得到url地址temp2<-getURL(url)write(temp2,"~/tt.txt")k=regexpr(pattern = "计划飞行距离.+km(&nbsp|</td>)",temp2)dat=regmatches(temp2,k)#dat=regmatches(dat,regexpr("\\d.+\\d",dat))dat
}
getKm("EY311")
getKm("EY191")
getKm("KL1763")
getKm("KL1139")
#查询指定航班所需飞行距离#==========tm包实现分词==================
# install.packages("tm")
library(tm)
??tm
doc=c("the first text","The second text")
corpus1=Corpus(VectorSource(doc))
adress=system.file("texts","crude",package="tm")
reuters=Corpus(DirSource(adress),readerControl=list(reader=readReut21578XML))
writeCorpus(reuters)
reuters=tm_map(reuters,as.PlainTextDocument,lazy=T)
reuters
#==========分词_jiebaR=========================
#install.packages("jiebaR")
library(jiebaR)
words = "我爱北京天安门,天安门上面有很多人在看升国旗，解放军真厉害"
tagger = worker("tag")
tagged = tagger <= words
#mode(tagged)
#str(tagged)
#attr(tagged, "names")
cutter_words<-data.frame(tag = attr(tagged, "names"),value = tagged)
noun_words<-cutter_words[which(cutter_words$tag %in% c('n','nt','ns')),]
noun_words<-noun_words$value
noun_words
library(sqldf)
result<-sqldf("select * from cutter_words where tag like '%n%'")
result$value=iconv(result$value,'utf-8','gbk')
resulttext = c("如果物品属于电商渠道","那么价格早就在网上认定了","可以直接按照价格赔偿","如果价值特别贵重，没有保价","一般来说快递公司不会按原价赔偿","因为贵重物品按照规定应该进行保价","具体赔偿金额需要双方协商")
library(jiebaR)
cc = worker("mix", bylines=T)
key = worker("keywords", topn = 4)
res = cc[text]
res_key = lapply(res, vector_keywords, key)
res_key
#==========分词_jiebaR案例1=========================
library(jiebaR)
dat=readLines("~/abc.txt",encoding = "UTF-8")
head(dat,1)
try1<-dat[1]
cc = worker("mix", bylines=T)
key = worker("keywords", topn = 10)
res = cc[dat]
res_key = lapply(res, vector_keywords, key)
head(res_key,1)
write.table(res_key,"rr.txt")
#==========wordcloud2===========
library(wordcloud)
# install.packages("wordcloud2")
library(wordcloud2)#==========mice包====================
# install.packages("mice")
library(mice)
??mice
imp=mice(sleep,seed=1234)
fit=with(imp,lm(Dream~Span+Gest))
pooled=pool(fit)
summary(pooled)
#==========Hmisc包================
install.packages("Hmisc")
library(Hmisc)#==========rjosn包==================
paste('{"m_crawlTime":{"$gt":"',Sys.Date()-3,'"},"m_newKeywords.0":{"$exists": 1},"m_Type" :  {"$ne" :38}}')# install.packages("rjson")
library(rjson)
rjson::fromJSON('{"m_crawlTime":{"$gt":"2016-04-15"},"m_newKeywords.0":{"$exists": 1},"m_Type" :  {"$ne" :38}}')
josn='{"m_crawlTime":{"$gt":"2016-04-15"},"m_newKeywords.0":{"$exists": 1}","m_Type" :  {"$ne" :38}}'
josn#==========分层抽样_sampling======================
# install.packages('sampling')
##  加载
library(sampling)
data("iris")
dat=iris
names(dat)=c("萼长","萼宽","瓣长","瓣宽","种类")
head(dat,3)
##　划分训练集与测试集用分层抽样函数Strata，在3类型鸢尾花数据中各抽取80%作为训练集，
##  保存在变量TrainingSet中；
##  余下的20%作为测试集，保存在变量TestSet中。过程如下所示：
nLevel=round(nrow(dat)*0.8/3,-1)
trainingSamp = strata(dat,stratanames="种类",size = rep(nLevel, 3), method="srswor")
head(trainingSamp)
#以Species变量作为分层变量
# 分层抽取训练样本，每层nPerLevel个
trainingSet = getdata(dat, trainingSamp$ID_unit)
# 训练集
testSet = getdata(dat,-trainingSamp$ID_unit)#==========KNN、测试集、训练集===============
# install.packages("FNN")
# install.packages("rknn")
library(FNN)
library(rknn)
library(gmp)
library(fpc)
data(iris3)
head(iris3)
train <- rbind(iris3[1:25,,1], iris3[1:25,,2], iris3[1:25,,3])
test <- rbind(iris3[26:50,,1], iris3[26:50,,2], iris3[26:50,,3])
cl <- factor(c(rep("s",25), rep("c",25), rep("v",25)))
knn(train, test, cl, k = 3, prob=TRUE)
plot(knn(train, test, cl, k = 3, prob=TRUE))#测试集、训练集划分
data(iris)
## select random train and test setsshuffled <- iris[sample(nrow(iris)),]
n.test <- 30
train <- sample(nrow(iris), nrow(iris) - n.test)x.train <- shuffled[train, -5]
y.train <- shuffled[train, 5]
x.test <- shuffled[-train, -5]
y.test <- shuffled[-train, 5]#==========R和tableau集成================
# install.packages("Rserve")
library(Rserve)
Rserve()#==========Rweibo包安装方法==================
# install.packages("Rweibo",repos = "http://R-Forge.R-project.org",type="source")
library(Rweibo)#==========rechart安装==================
# install.packages("recharts")
library(recharts)#==========SVM相关包========
# install.packages("e1071")
library(e1071)
svm()#==========shiny分割线============
# install.packages("shiny")
# shiny分为ui.R和sever.R
# 其中ui.R为图形生成部分；sever.R为服务器调用部分#==========归一化处理========
require(stats)
x <- matrix(1:10, ncol = 2)
(centered.x <- scale(x, scale = FALSE))
cov(centered.scaled.x <- scale(x)) # all 1
#原理是z-score，δ=(x-mean)/sd#==========infotheo包：互信息========
library('infotheo')
x=c(0,1,1,1)
y=c(1,1,1,1)
mutualinformation=mutinformation(x,y)
#x向量与y向量的互信息量mutualinformation=0#==========Github和recharts=============
library(devtools)
install_github('yihui/recharts')#solution: there is no package called 'digest'
install.packages("digest")library(recharts)#==========神经网络:nnet=============
library(nnet)
??nnet
nnet()#==========misTools=============
#misTools中的insrtRow、insertCol函数
# install.package(miscTools)
library(miscTools)
m <- matrix( 1:4, 2 )
insertRow( m, 2, 5:6 )
insertCol( m, 2, 5:6 )#=========SparkR===========
install.packages("sparkR")
install_github("amplab-extras/SparkR-pkg", subdir="pkg")  #=========与Excel的交互========
#=========r2excel======
# library(devtools)
# devtools::install_github("kassambara/r2excel")
library(r2excel)
#=========与word交互============
#=========ReporteRs--Knitr|Rmarkdown|============
# install.packages("ReporteRs")
require(ReporteRs)#=============tibble============
install.packages('tibble')#==========Ending==========================
#清除变量
rm(list=ls())

技巧篇：常用的R代码汇总相关推荐

1. 技巧篇：常用的python代码汇总

   一些常用的python代码合集,方便检索引用 模块1:读写excel文件 from datetime import datetime import odps import xlwt import os ...

2. 40个常用的CSS代码汇总

   1.清除浮动 主要为子元素浮动(float)之后,父元素无法撑起高度和宽度. <!-- html --><div class="clear"> <im ...

3. python popen函数讲解_Python常用模块函数代码汇总解析

   一.文件和目录操作 创建.删除.修改.拼接.获取当前目录.遍历目录下的文件.获取文件大小.修改日期.判断文件是否存在等.略 二.日期和时间(内置模块:time.datatime.calendar) 1 ...

4. （2021年）IT技术分享社区个人文章汇总（电脑技巧篇）

   2021年即将成为过去,崭新的2022年即将到来,小编坚持每天给大家分享IT技术相关的文章,希望小编分享的文章能够给大家在日常的工作当中,带来一点帮助.也感谢大家对本公众号的支持,未来我会坚持创作,给 ...

5. ASP.NET程序中常用代码汇总（四）

   31. 当文件在不同目录下,需要获取数据库连接字符串(如果连接字符串放在Web.config,然后在Global.asax中初始化) 在Application_Start中添加以下代码: Applic ...

6. PS如何生成svg代码格式的path路径 - PS技巧篇

   PS如何生成svg代码格式的path路径 - PS技巧篇 原文标题:PS中的svg工具是怎么使用的 点击查看:百度教程 技巧,切图出来的小图片,可以通过ps打开,右键生成SVG格式的代码. 以上就是关 ...

7. 26篇计量经济经典论文复现数据和Stata或R代码

   26篇文章的复现数据.Stata或R复制程序.各位学者可以阅读这些文章,并根据Stata和R代码对原文中的图表进行一一复制,只有这样才能成长更快. 以其中一篇文章为例,包含了以下内容: [26篇论文目 ...

8. ASP.NET程序中常用代码汇总-1[转]

   相关链接: ASP.NET程序中常用代码汇总-1 ASP.NET程序中常用代码汇总-2[转] ASP.NET程序中常用代码汇总-3[转] ASP.NET程序中常用代码汇总-4[转] ASP.NET程序 ...

9. Word2003快速操作技巧及常用快捷键使用

   Word2003快速操作技巧及常用快捷键使用站外博客黑板报! 聚集博客们思想! 话题搜索: 此文仅供学习与交流!马上开通自己博客 您可以操作:推荐T出去站点收录 系统提示:博客精华与否全由网友置顶!您 ...

最新文章

1. Linux进程编程基础介绍
2. C语言练习题100道
3. Linux追加文件内容并在内容前加上该文件名（awk, FILENAME功能妙用）
4. ES内存持续上升问题定位
5. java的String构造对象的几种方法以及内存运行过程
6. medianBlur函数
7. java邮箱找回密码_Spring实现简单的邮箱找回密码功能
8. ASP.NET MVC 4 (十) 模型验证
9. 带有Flask的服务器端DataTable
10. 源码阅读 AtomicInteger
11. webpack热更新和常见错误处理
12. android获取textview的行数
13. MapReducer随笔小记
14. ACAD shx字体格式之BigFont
15. 35、T5L 迪文屏C51开发之音频播放
16. GPS 入门 1 —— 基础知识
17. easyExcel导入导出(列锁定单元格、表头合并、导出类型限制、锁定单元格增加底色、设置密码、隐藏列等)
18. mybatis使用truncate清空表
19. 苦于抖音四季文案久已的朋友们快看过来！
20. 【必拿下系列】106. 从中序与后序遍历序列构造二叉树105从前序与中序遍历序列构造二叉树

热门文章

1. MySQL 8.0 物理备份xtrabackup简介
2. 黑客电影预言或成真,英国核潜艇安全问题堪忧
3. 从零开始Kubernetes CronJob实现任务调度
4. 【智能优化算法】基于黑寡妇优化算法求解单目标优化问题含Matlab源码
5. 2013年中国最新MBA学费对比
6. MySQL数据字典提示1146不存在的问题解决
7. 鸿合一体机触屏没反应怎么办_一体机电脑触摸屏没反应怎么办 触摸屏一体机故障解决方法...
8. python unrar问题_python利用unrar实现rar文件解压缩
9. 荒木毬菜 小情歌日文版 - 独身OL之歌
10. CM3学习笔记（一）存储器系统