R语言基础编程技巧汇编 - 8

1.       修改坐标轴的标示文字

aaa<-rnorm(100,2,1)

bbb<-rep(1:5,20)

#bbb<-rep(c("A","B","C","D","E"),20)

plot(bbb,aaa,axes =FALSE)

axis(1,at =c(1,2,3,4,5),labels=c("A","B","C","D","E"))

axis(2,at = c(0,1,2,3,4,5))

2.      一组数据换成另一种类型记录

现在有一组数据,我想换成另一种格式记录,比如一组数据

v<- c(90, 50, 89, 86, 75, 62, 65,95, 96, 85, 87, 75, 74, 93, 63)

 

这样一组数据,我想换成ABCDE来记录,也就是

 

v>= 90, 记为A

90>v>=80,记为B

80>v>=70,记为C

70>v>=60,记为D

v<60,记为E.

 

处理方法:

新建一个向量,然后赋值。

比如新建一个h

h<-vector()

h[v>=90]<- "A"

h[v<90 &&v>=80]<-"B"

...

3.      因子得分

data(USArrests)

fa <- factanal(~., factors = 1,data = USArrests, score = "Bartlett", rotation = "none") #不做旋转  

D <- diag (fa $uniquenesses)   #特殊方差

  

A <-as.matrix(fa$loadings[,1])  #载荷矩阵

 

D1 <- solve(D)  #D的逆矩阵

x <- t(as.matrix(USArrests))

 

#Bartlett方法(最小二乘法)

#因子得分为

f <- solve(t(A) %*% D1 %*% A) %*%t(A) %*% D1 %*% x  

  

#然后标准化就是fa$scores

fa <- factanal(~., factors = 1,data = USArrests, score = "regression", rotation = "none")

r <- fa$correlation #x的相关矩阵

#Thompson方法(回归方法)

f <- t(A) %*% solve(r) %*% x

 

4.      因子重新排序

dat <- data.frame(x = rnorm(30),grp = factor(sample(c("AL", "FL", "MO"), 30,replace = TRUE)))

boxplot(x ~ grp, data = dat)

 

上面是按顺序的图

 

下面重新排列

dat$grp<-factor(dat$grp, levels =c("FL", "AL", "MO"))

boxplot(x ~ grp, data = dat)


5.      用plyr包扩展apply族函数的功能

apply族函数是R语言中很有特色的一类函数,包括了applysapplylapplytapplyaggregate等等。在这篇博文里对它们进行了简略的说明。这一类函数本质上是将数据进行分割、计算和整合。它们在数据分析的各个阶段都有很好的用处。例如在数据准备阶段,我们可以按某个标准将数据分组,然后获得各组的统计描述。或是在建模阶段,为不同组的数据建立模型并比较建模结果。apply族函数与Google提出的mapreduce策略有着一致的思路。因为mapreduce的思路也是将数据进行分割、计算和整合。只不过它是将分割后的数据分发给多个处理核心进行运算。如果你熟悉了apply族函数,那么将数据转为并行运算是轻而易举的事情。plyr包则可看作是apply族函数的扩展,使之更容易运用,功能更为强大。

 

plyr包的主函数是**ply形式的,其中首字母可以是(dla),第二个字母可以是(dla_),不同的字母表示不同的数据格式,d表示数据框格式,l表示列表,a表示数组,_则表示没有输出。第一个字母表示输入的待处理的数据格式,第二个字母表示输出的数据格式。例如ddply函数,即表示输入一个数据框,输出也是一个数据框。

 

下面首先来用一个简单的例子说明一下用法。还是用iris数据集,其中包括了一个分类变量和四个数值变量。我们希望数据按不同类别,分别计算数值变量的均值。下面我们分别用三种方法来得到同样的结果。

 

library(plyr)

library(reshape2)

# aggregate函数进行数据汇总

aggregate(iris[1:4],list(iris$Species),mean)

# reshape2包进行数据汇总

data.melt <-melt(iris,id=c('Species'))

dcast(data.melt,Species~variable,mean)

# ddply函数进行数据汇总

ddply(iris,.(Species),function(df) mean(df[1:4]))

初看起来plyr包所具备的功能并不很出彩,下面我们看一个略为复杂例子。还是用iris数据,我们希望对每一种花做一个简单回归。

 

# 首先定义回归函数

model <- function(x) {

    lm(Petal.Length~Petal.Width,data=x)

}

# 如果用普通的函数则需要如下的分割、计算、整合三个步骤共四条命令

pieces <- split(iris,list(iris$Species))

models <- lapply(pieces,model)

result <- lapply(models,coef)

do.call('rbind',result)

# plyr包只用下面两个函数,每个函数都内置了分割、计算、整合的功能。

result1 <-dlply(iris,.(Species),model)

result2 <- ldply(result1,function(x) coef(x))

plyr包中还有两个比较特别的函数,分别是r*plym*ply,它们分别对应的是replicatemapply函数。

 

replicate(20,mean(runif(100)))

rdply(20, mean(runif(100)))

mapply(rnorm,mean=1:5,sd=1:5, n=2)

mdply(data.frame(mean = 1:5, sd = 1:5), rnorm,n = 2)

最后我们来看一个mdply函数的应用,我们希望用神经网络包来为不同的花进行分类,使用BP神经网络需要的一个参数就是隐藏层神经元的个数。我们来尝试用110这十个参数运行模型十次,并观察十个建模结果的预测准确率。但我们并不需要手动运行十次。而是使用mdply函数来完成这个任务。

 

library(nnet)

# 确定建模函数

nnet.m <- function(...) {

  nnet(Species~.,data=iris,trace=F,...)

}

# 确定输入参数

opts <- data.frame(size=1:10,maxiter=50)

# 建立预测准确率的函数

accuracy <- function(mod,true){

  pred <- factor(predict(mod,type='class'),levels=levels(true))

  tb <- table(pred,true)

  sum(diag(tb))/sum(tb)

}

# mlply函数建立包括10个元素的列表,每个元素包括了一个建模结果

models <- mlply(opts,nnet.m)

# 再用ldply函数读取列表,计算后得到最终结果

ldply(models,'accuracy',true=iris$Species)By 写长城的诗

 

6.      rvest包采集足球彩票信息

library(rvest)

library(stringr)

 

url ='http://cp.win007.com/buy/toto14.aspx?issueNum=2015004'

session = url %>% html_session()%>% html_nodes("table") %>% .[[2]] %>%

 html_nodes("td:nth-child(1)") %>% html_text() %>% .[-1]

场次 = session[seq(1,length(session),5)]

event = url %>% html_session()%>% html_nodes("table") %>% .[[2]] %>%

 html_nodes("td:nth-child(2)") %>% html_text() %>% .[-1]

赛事 = event[seq(1,length(event),4)]

开赛时间 = url %>% html_session() %>% html_nodes("table") %>%.[[2]] %>%

 html_nodes("td:nth-child(3)") %>% html_text() %>% .[-1]

主队 = url %>% html_session() %>% html_nodes("table") %>%.[[2]] %>%

 html_nodes("td:nth-child(4)") %>% html_text() %>% .[-1]%>%

 str_replace('\r\n\t\t\t','')

客队 = url %>% html_session() %>% html_nodes("table") %>%.[[2]] %>%

 html_nodes("td:nth-child(5)") %>% html_text() %>% .[-1]%>%

 str_replace('\r\n\t\t\t','')

分析 =  url %>% html_session()%>% html_nodes("table") %>% .[[2]] %>%

 html_nodes("td:nth-child(12)") %>% html_text() %>% .[-1]%>%

 str_replace('\r\n\t\t\t\t','') %>% str_extract("")

 

状态 = url %>% html_session() %>% html_nodes("table") %>%.[[2]] %>%

 html_nodes("td:nth-child(13)") %>% html_text()

比分 = url %>% html_session() %>% html_nodes("table") %>%.[[2]] %>%

 html_nodes("td:nth-child(14)") %>% html_text()

半场 = url %>% html_session() %>% html_nodes("table") %>%.[[2]] %>%

 html_nodes("td:nth-child(15)") %>% html_text()

彩果 = url %>% html_session() %>% html_nodes("table") %>%.[[2]] %>%

 html_nodes("td:nth-child(16)") %>% html_text()

基础信息 = data.frame(场次=场次,赛事=赛事,开赛时间=开赛时间,主队=主队,客队=客队,分析=分析,状态=状态,比分=比分,半场=半场,彩果=彩果)

 

u ='http://cp.win007.com/handle/handicap.aspx?issuenum=2015004&typeid=1&companyid=3&1420858993000'

asia = u %>% html() %>%html_nodes("i") %>% html_text() %>% str_split(",")%>% do.call(rbind,.) %>% .[,c(2,4,5,6)] %>% as.data.frame

asia[,1] = as.numeric(asia[,1])

皇冠亚赔 = asia[order(asia[,1]),][-1]

 

v ='http://cp.win007.com/handle/1x2.aspx?issuenum=2015004&typeid=1&companyid=9&1420859179000'

uro = v %>% html() %>%html_nodes("i") %>% html_text() %>% str_split(",")%>% do.call(rbind,.) %>% .[,c(2,7,8,9)] %>% as.data.frame

 

uro[,1] = as.numeric(uro[,1])

威廉欧赔 = uro[order(uro[,1]),][-1]

 

total = cbind(基础信息,威廉欧赔,皇冠亚赔)

 

 

7.      禁止将读取的字符数据因子化

read.table的参数中设置:stringsAsFactors = FALSE

 

8.       控制外部软件运行

system函数可以调用操作系统的命令,在WindowsLinux中不同,以Windows为例,假如你已经安装了firefox的浏览器在下面的目录中,则通过下列命令可以用浏览器打开指定的网页:

system(paste('"c:/ProgramFiles/Mozilla Firefox/firefox.exe"', '-url cran.r-project.org'), wait =FALSE)

 

9.      生成一列日期数据

 

d1 <- as.Date('2011-1-1')

d2 <- as.Date('2013-1-1')

d <- seq(d1, d2,by="day")

 

10. 用curve函数绘制函数曲线

f=function(x) x^2+x^3

curve(f,-3,3)


11. 改变坐标轴字体

首先要用windowsFonts对字体进行赋值:

windowsFonts(FS = windowsFont("仿宋"))

windowsFonts(HT = windowsFont("黑体"))

此后就可以用参数 family="Song"来改变字体了,例如我们简单画一个图,并将其横轴上的坐标改为宋体:

plot(rnorm(30), xaxt="n") #这一步当中要先把x轴上的数字去掉,再重新用axis()函数加上

axis(side=1, family="FS") #加上字体为宋体(Song)的x轴刻度数字

 

注意font参数不是调整字体的,而是调整字的形式,包括常规、粗体、斜体、斜粗等。

plot(rnorm(30), xaxt="n")axis(side=1,family="FS", font=2)

 

另外R中的默认字族为serifsansmono,可以直接用,其代表的具体字体可以下面代码查看

> windowsFonts()$serif[1] "TTTimes New Roman"

$sans[1] "TT Arial"

$mono[1] "TT Courier New"

 

如果想改变的是坐标轴标签的字体,可以在title()函数里加入family参数:

plot(rnorm(30), ann=F,xaxt="n", yaxt="n") # 这里的ann参数去掉了坐标轴标签axis(side=1,family="serif", font=3)axis(side=2, family="mono", las=1) #参数las使刻度数字保持横向显示title(xlab="这是横轴", family="FS", font.lab=2, cex.lab=1.5) # 利用参数将横轴坐标加大、加粗title(ylab="这是纵轴") #均为默认值,作对比title(main="30个正态分布随机数的散点图", family="HT",font.main=4, cex.main=2)

 

以下为上面命令生成的效果图(.png):

 

PS:注意以下两点

1、以上一些参数可以用在plot()函数体中,一些可以用par()函数对全局进行改变,随要求自己改。

2、以上办法在生成矢量图的时候会出问题,具体的参考pdf()postscript()等函数的说明。

12. 趣味实现:用R语言谱曲

library(sound)

s0 <- Sine(0,0.5)

s1 <- Sine(523.25,0.25)

s2 <- Sine(587.33,0.25)

s3 <- Sine(659.26,0.25)

s4 <- Sine(698.46,0.25)

s5 <- Sine(784,0.25)

s6 <- Sine(880,0.25)

s7 <- Sine(987.77,0.25)

s11 <- Sine(1046.5,0.25)

s12 <- Sine(1174.66,0.25)

s13 <- Sine(1318.51,0.25)

B1<-appendSample(s0,s5,s5,s3,s3,s4,s4,s5,s5,s5,s5,s5,s5);

B2<-appendSample(s0,s5,s5,s3,s3,s4,s4,s5,s5,s5,s5,s5,s5);

B3<-appendSample(s0,s5,s5,s3,s3,s4,s4,s5,s5,s5,s11,s11,s12);

B4<-appendSample(s7,s7,s7,s7,s7,s7,s3,s5,s5,s5,s5,s5,s0);

B5<-appendSample(s5,s6,s6,s13,s13,s12,s12,s12,s12,s12,s12,s12,s12);

B6<-appendSample(s3,s5,s5,s12,s12,s12,s11,s11,s11,s11,s11,s11,s11);

B7<-appendSample(s3,s4,s4,s11,s11,s11,s11,s12,s13,s13,s11,s11,s7,s7,s7,s11,s11,s11,s11,s11);

s<-appendSample(B1,B2,B3,B4,B5,B6,B7);

s<-mirror(s)

play(s)

 

 

再附上一首完整点的

ss5<- Sine(391,0.25);

s0 <- Sine(0,0.25);

s1 <- Sine(523.25,0.25);

s2 <- Sine(587.33,0.25);

s3 <- Sine(659.26,0.25);

s4 <- Sine(698.46,0.25);

s5 <- Sine(784,0.25);

s6 <- Sine(880,0.25);

s7 <- Sine(987.77,0.25);

s11 <- Sine(1046.5,0.25);

s12 <- Sine(1174.66,0.25);

s13 <- Sine(1318.51,0.25);

s14 <- Sine(1397,0.25);

s15 <- Sine(1568,0.25);

A1<-appendSample(s0,ss5,s3,s2,s3,s2,s3,s5);

A2<-appendSample(s0,s2,s3,s2,s3,s2,s3,s5);

A3<-appendSample(s0,s2,s3,s2,s3,s7,s7,s5);

A4<-appendSample(s5,s5,s5,s5,s5,s5,s4,s4,s3,s3);

A5<-appendSample(s1,s2,s1,s1,s1,s5,s5,s5);

A6<-appendSample(s5,s2,s3,s1,s1,s1,ss5);

A7<-appendSample(s5,s5,s6,s6,s6,s2,s2,s2,s2,s2,s2);

A8<-A1;A9<-A2;

A10<-appendSample(s7,s7,s11,s7,s5,s3,s3,s3);

A11<-appendSample(s5,s5,s5,s5,s5,s6,s11);

A12<-appendSample(s12,s12,s11,s6,s6,s6,s6,s6);

A13<-appendSample(s6,s5,s5,s5,s3,s2,s1,s1);

A14<-appendSample(s2,s2,s2,s2,s3,s3,s3,s3);

A15<-appendSample(s4,s4,s4,s4,s5,s5,s5,s5);

A16<-appendSample(s6,s6,s6,s6,s13,s13,s12,s12);

A17<-appendSample(s12,s12,s12,s12,s0,s5);

A18<-appendSample(s7,s7,s7,s5,s3,s2,s3,s3);

A19<-appendSample(s3,s3,s3,s3,s5,s5,s6,s6);

A20<-appendSample(s1,s1,s1,s3,s3,s5,s5,s6,s6);

A21<-appendSample(s5,s5,s5,s13,s13,s12,s12,s11,s11);

A22<-appendSample(s0,s13,s13,s13,s12,s13,s12,s15,s15,s14,s14,s13,s13,s11,s11);

A23<-appendSample(s11,s11,s11,s11,s11,s6,s1);

A24<-appendSample(s7,s7,s7,s7,s0,s7,s7,s5);

A25<-appendSample(s5,s3,s3,s3,s3,s5,s5,s6,s6);

A26<-appendSample(s6,s6,s6,s3,s3,s5,s5,s6,s6);

A27<-appendSample(s1,s1,s1,s3,s3,s5,s5,s6,s6);

A28<-appendSample(s1,s1,s1,s6,s6,s5,s5,s3,s3,s1,s1,s1,s1,s1,s1,s1,s1);

s<-appendSample(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18,A19,A20,A21,A22,A23,A24,A25,A26,A27,A28);

s<-mirror(s);

play(s)     

13. 雷达图(戴布拉图、螂蛛网图)

library(fmsb)

maxmin <- data.frame(

total=c(5,1),

phys=c(15,3),

psycho=c(3,0),

social=c(5,1),

env=c(5,1))

# data for radarchart functionversion 1 series, minimum value must be omitted from above.

RNGkind("Mersenne-Twister")

set.seed(123)

dat <- data.frame(

total=runif(3,1,5),

phys=rnorm(3,10,2),

psycho=c(0.5,NA,3),

social=runif(3,1,5),

env=c(5,2.5,4))

dat <- rbind(maxmin,dat)

op <-par(mar=c(1,2,2,1),mfrow=c(2,2))

radarchart(dat,axistype=1,seg=5,plty=1,title="(axis=1,5 segments)")

radarchart(dat,axistype=2,pcol=topo.colors(3),plty=1,title="(topo.colors,axis=2)")

radarchart(dat,axistype=3,pty=32,plty=1,axislabcol="grey",na.itp=FALSE,title="(nopoints, axis=3, na.itp=FALSE)")

radarchart(dat,axistype=0,plwd=1:5,pcol=1,title="(uselty and lwd but b/w, axis=0)")

par(op)

.

14.  箱线图带数值标签

zhengli=read.csv("C:\\Users\\acer\\Desktop\\zhengli.csv")

attach(zhengli)

x=boxplot(lingjian,horizontal=T,col="bisque");x

text(c(as.vector(x[[1]])),c(1.2,1.3,1.3,1.3,1.2),

paste(c('最小值','下四分位数','中位数','上四分位数','最大值'),

as.character(x[[1]]),sep='\n'),col='blue')

 

 

 

 

 

15. cat函数的作用

cat是输出一些信息,帮助你理解程序的运行情况。比如你有一个很慢的循环,你可以在里面加上cat(i),这样你就可以知道运行到第几个循环了。即使程序出错你也可以知道是第几个循环出的问题,才好更进一步的查找问题的所在。

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值