R七种武器？

2 minute read

Published: February 08, 2018

##2018-02-08 R七种武器

今日听说有所谓R七种武器之说，虽然短时间没有参加其课程的打算但可以丰富R的资料库，下面是简单的介绍：

###R七种武器之金融数据分析quantmod quantmod就是提供给宽客们使用的专业模块，Quantmod具有强大的数据抓取，绘画专业行情分析图表以及各种技术指标计算等功能，常常只要几行函数就能完成从数据获取和处理到画图的复杂功能，其工作效率之高让行家里手都觉得膛目结舌。内容：

金融数据分析概述，量化投资，统计套利，算法交易
quantmod的ETL功能，抓获和处理行情数据
股市数据分析，条形图，蜡烛图，线图，技术指标分析

虽然暂时没有这种业务，之后可能会用得上。 quantmod

###R七种武器之交互化展示包shiny shiny包可以直接通过写纯R代码来生成网络应用。用户不再需要烦心如何能把分析结果放到网上，也不必烦恼使用一个模型不同的参数来罗列一大堆相似的模型。shiny帮助用户把数据分析模型变成任何人都可以使用的交互式Web应用程序，并让整个过程变得超级简单内容：

shiny包概述，各种基础函数介绍
简单的应用：生成动态图形，生成回归模型，动态人口分析
案例分析，从案例中掌握shiny包的应用

值得一学,据说可以借助这个工具写自己的应用。一些有用的链接： shiny集锦 shiny做地图

###R七种武器之网络爬虫RCurl RCurl包是R语言中最常用的爬虫工具，广泛用于在互联网上抓取各种数据源，例如金融数据，行情数据，价格数据，体育数据等，用于进行后续建模分析。信息时代，互联网已经毫无置疑地渗透到我们生活工作的各个细节，因此它本身亦成为日益重要的大数据来源。内容：

HTTP协议，RCurl包概述，主要函数初识
RCurl包深入讲解，查看服务器端信息，认证，表单提交等，各函数用途及有关参数设置
正则表达式，实例演练，利用RCurl包写一个小爬虫抓取数据

系统性学习R的网络爬虫推荐，其他的类似httr，XML,Xpath工具都是必要的：基于R语言的自动数据收集

###R七种武器之数据加工厂plyr plyr包遵循三位一体的Split-Apply-Combine（拆分数据，应用函数，组合结果）思想，设置了超过50个函数来应对各类型数据和处理的情况，使数据处理变得极为简单方便，极大地提高了数据处理的效率，plyr包是R扩展包中的精品，完全有必要纳入到我们的“七种武器”行列。内容：

Split-Apply-Combine思想，plyr包概述，数据加工主函数介绍和应用
神奇的数据加工辅助函数、函数加工器介绍和应用
实战操练，从案例分析看如何巧用plyr包来提高处理效率

现在似乎dplyr更加流行，Coursera课程上有所介绍，很方便优雅的pipline编码方法。 dplyr

###R七种武器之数据展现包ggplot2 于使用ggplot2包，可以使用家在非常短的时间里就能构建复杂而漂亮的图表，可以为你的报告增色，给你的听众留下良好深刻的印象！内容：

GGplot2包概述，从qplot开始GG之旅
图形对象，层，ggplot函数
基本作图：散点图，柱形图，线图，分布图，地图等
Scales和theme
更复杂技巧：画多幅图，输出到文件，画函数图象，向量场，动态气泡图和动画

强大的作图工具，配合dplyr口味更佳。 ggplot2

###R七种武器之文本挖掘涉及好几个包，Rwordseg，tm，wordcloud，NLP等

###R七种武器之Google地图包RgoogleMaps

介于百度Echart的强大功能，可以使用其R接口，Rechart来调用。 Echart Rechart Rechart shiny(真牛……)

##2020年3月18日 R simulation HLM R simulate不同的group size和number of group下HLM的表现

rep<-1000
N<-5000
N_G<-1000
Size_G<-N/N_G

outdata<-data.frame("int_lme"=rep(NA,rep),"x1_lme"=rep(NA,rep),"x2_lme"=rep(NA,rep),"x3_lme"=rep(NA,rep),
"int_lme_se"=rep(NA,rep),"x1_lme_se"=rep(NA,rep),"x2_lme_se"=rep(NA,rep),"x3_lme_se"=rep(NA,rep),
"int_lm"=rep(NA,rep),"x1_lm"=rep(NA,rep),"x2_lm"=rep(NA,rep),"x3_lm"=rep(NA,rep),
"int_lm_se"=rep(NA,rep),"x1_lm_se"=rep(NA,rep),"x2_lm_se"=rep(NA,rep),"x3_lm_se"=rep(NA,rep)
)

i=1
while(i<=rep) {
  x1<-rnorm(N, mean = 15, sd=sqrt(10))
  x2<-ifelse(runif(N, min=0, max=1)>=0.5,1,0)
  x3<-rpois(N, 4)
  e<-rnorm(N, mean = 0, sd=sqrt(3))
  u<-rnorm(N_G,0,sqrt(2))
  u<-rep(u,each=Size_G)
  clu<-1:N_G
  clu<-rep(clu,each=Size_G)
  y<-1+0.2*x1+0.3*x2-0.3*x3+u+e
  data2<-data.frame(y,x1,x2,x3,u,e,clu)
  
  fit<-try(lme(y~ x1+x2+x3,data = data2,random = ~ 1 | clu),silent=TRUE)
  
  if('try-error' %in% class(fit)){
next
  }else{
out<-lme(y~ x1+x2+x3,data = data2,random = ~ 1 | clu)
outdata$int_lme[i]=as.numeric( out$coefficients$fixed[1])
outdata$x1_lme[i]=as.numeric(out$coefficients$fixed[2])
outdata$x2_lme[i]=as.numeric(out$coefficients$fixed[3])
outdata$x3_lme[i]=as.numeric(out$coefficients$fixed[4])
outdata$int_lme_se[i]=as.numeric(sqrt(diag(vcov(out)))[1] )
outdata$x1_lme_se[i]=as.numeric(sqrt(diag(vcov(out)))[2] )
outdata$x2_lme_se[i]=as.numeric(sqrt(diag(vcov(out)))[3] )
outdata$x3_lme_se[i]=as.numeric(sqrt(diag(vcov(out)))[4] )

out<-lm(y~ x1+ x2+ x3, data = data2)
outdata$int_lm[i]=as.numeric(out$coefficients[1])
outdata$x1_lm[i] =as.numeric(out$coefficients[2])
outdata$x2_lm[i] =as.numeric(out$coefficients[3])
outdata$x3_lm[i] =as.numeric(out$coefficients[4])
outdata$int_lm_se[i]=as.numeric(sqrt(diag(vcov(out)))[1])
outdata$x1_lm_se[i]=as.numeric(sqrt(diag(vcov(out)))[2])
outdata$x2_lm_se[i]=as.numeric(sqrt(diag(vcov(out)))[3])
outdata$x3_lm_se[i]=as.numeric(sqrt(diag(vcov(out)))[4])

i=i+1
cat("Complete  \r %", round(i/10))
  }
}

# 6. Construct confidence intervals 
dat1<-cbind(outdata[,1:8],group="lme")
dat2<-cbind(outdata[,9:16],group="lm")
names(dat2)<-names(dat1)
plotdata<-rbind(dat2,dat1)
plotdata$Group<-plotdata$group
levels(plotdata$Group)<-c("LM", "RIM")
plotdata$id<-1:rep
plotdata$zero=0

a<-ggplot(plotdata, aes(x=id, y=zero, group = Group, color=Group)) + 
  geom_errorbar(aes(ymin=zero-int_lme_se,ymax=zero+int_lme_se),alpha=0.4)  +
  geom_point(size=0.01, color="grey")+
  scale_color_manual(values=c("#F8766D","#00BFC4")) +
  labs(title="A. Intercept",x="", y = "95% Confidence Interval")+
  theme_classic() 

b<-ggplot(plotdata, aes(x=id, y=zero, group = Group, color=Group)) + 
  geom_errorbar(aes(ymin=zero-x1_lme_se,ymax=zero+x1_lme_se),alpha=0.4)  +
  geom_point(size=0.01, color="grey")+
  scale_color_manual(values=c("#F8766D","#00BFC4")) +
  labs(title="B. X1",x="", y = "")+
  theme_classic() 

c<-ggplot(plotdata, aes(x=id, y=zero, group = Group, color=Group)) + 
  geom_errorbar(aes(ymin=zero-x2_lme_se,ymax=zero+x2_lme_se),alpha=0.4)  +
  geom_point(size=0.01, color="grey")+
  scale_color_manual(values=c("#F8766D","#00BFC4")) +
  labs(title="C. X2",x="", y = "95% Confidence Interval")+
  theme_classic() 

d<-ggplot(plotdata, aes(x=id, y=zero, group = Group, color=Group)) + 
  geom_errorbar(aes(ymin=zero-x3_lme_se,ymax=zero+x3_lme_se),alpha=0.4)  +
  geom_point(size=0.01, color="grey")+
  scale_color_manual(values=c("#F8766D","#00BFC4")) +
  labs(title="D. X3",x="", y = "")+
  theme_classic() 

figure2<-ggarrange(a,b,c,d,
   ncol = 2, nrow = 2)

png("lab2_fig2.png",width = 800, height =800)
figure2
dev.off()

2020年3月18日 R simulation HLM 之二

Simulation 不同的cluster variance对HLM的performance

rand_vect <- function(N, M, sd = 1, pos.only = TRUE) {
  vec <- rnorm(N, M/N, sd)
  if (abs(sum(vec)) < 0.01) vec <- vec + 1
  vec <- round(vec / sum(vec) * M)
  deviation <- M - sum(vec)
  for (. in seq_len(abs(deviation))) {
vec[i] <- vec[i <- sample(N, 1)] + sign(deviation)
  }
  if (pos.only) while (any(vec < 0)) {
negs <- vec < 0
pos  <- vec > 0
vec[negs][i] <- vec[negs][i <- sample(sum(negs), 1)] + 1
vec[pos][i]  <- vec[pos ][i <- sample(sum(pos ), 1)] - 1
  }
  return(vec)
}



sim_lmer<-function(rep=1000,ng=50,gs=20,gvar=5) {
# rep<-1000
# ng<-50
# gs<-20
# gsvar=5

  N<-ng*gs
  
  #sim groupsize
  outsta<-NULL
  distr <- rand_vect(N=ng,M=ng*gs,sd=gvar) 
  sum(distr)
  sd(distr)
  
  for (i in 1:rep) {

x1<-rnorm(N, mean = 15, sd=sqrt(10))
x2<-rbinom(N,1,0.5)
x3<-rpois(N, 4)
e<-rnorm(N, mean = 0, sd=sqrt(3))


clu<-rep(1:ng,distr)

u0<-rnorm(ng,0,sqrt(2))
u0<-rep(u0,distr)

u1<-rnorm(ng,0,sqrt(2))
u1<-rep(u1,distr)


y<-1+0.2*x1+0.3*x2-0.3*x3+u0+u1*x1+e

regdata<-as.data.frame(cbind(clu,y,x1,x2,x3)) 

out<-lmer(y~x1+x2+x3+(1+x1||clu),data=regdata)

rand<-as.data.frame(VarCorr(out))[1:2,4]
names(rand)<-c("rand_int","rand_x1")

outsta<-rbind(outsta,c(fixef(out),rand))

cat("Complete  \r %", round(i/rep*100))
  }
  
  
  gensta<-function(a) {
# paste0(round(mean(a),3),
#"(",round(quantile(a, .025),3),
#"~",round(quantile(a, .975),3),")")
paste0(round(mean(a),3),
   "(", round(mean((a-mean(a))^2),3) ,")")

  }
  output<-apply(outsta, 2, gensta)
  return(as.vector(output))


}


output<-rbind(sim_lmer(ng=50,gs=30,gvar=0),
  sim_lmer(ng=50,gs=30,gvar=5),
  sim_lmer(ng=50,gs=30,gvar=10),
  sim_lmer(ng=50,gs=30,gvar=20),
  sim_lmer(ng=100,gs=30,gvar=0),
  sim_lmer(ng=100,gs=30,gvar=5),
  sim_lmer(ng=100,gs=30,gvar=10),
  sim_lmer(ng=100,gs=30,gvar=20),
  sim_lmer(ng=200,gs=30,gvar=0),
  sim_lmer(ng=200,gs=30,gvar=5),
  sim_lmer(ng=200,gs=30,gvar=10),
  sim_lmer(ng=200,gs=30,gvar=20)
  )



write.csv(output,"simout.csv")

Share on

Twitter Facebook Google+ LinkedIn

夏一巍 Nemo

R七种武器？

2020年3月18日 R simulation HLM 之二

Share on

You May Also Enjoy

网站

机器学习技能树

SAS生成协方差矩阵

2014-08-09 SAS simulation 实验