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

 

plyr包的主函数是**ply形式的，其中首字母可以是(d、l、a)，第二个字母可以是(d、l、a、_)，不同的字母表示不同的数据格式，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*ply和m*ply，它们分别对应的是replicate和mapply函数。

 

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神经网络需要的一个参数就是隐藏层神经元的个数。我们来尝试用1到10这十个参数运行模型十次，并观察十个建模结果的预测准确率。但我们并不需要手动运行十次。而是使用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函数可以调用操作系统的命令，在Windows和Linux中不同，以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中的默认字族为serif，sans和mono，可以直接用，其代表的具体字体可以下面代码查看

> 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)，这样你就可以知道运行到第几个循环了。即使程序出错你也可以知道是第几个循环出的问题，才好更进一步的查找问题的所在。