使用 mapply 将多个 R ggplots ecdf par 页面保存到 pdf 文件中
Save multiple R ggplots ecdf par page into a pdf file with mapply
我将一个变量的经验累积分布函数与 3 个理论累积分布函数进行比较。我对 150 个变量执行此操作，并希望将结果打印在一个 PDF 文件中，每页有 4 个图表。我不使用循环，而是使用 mapply。理想情况下，我可以使用 par(mfrow=c(2,2)) 但我认为这仅适用于 R 基础对象而不适用于 ggplot。我查看了 gridExtra 包 here 但没有找到如何继续。
library(evd)
library(MASS)
library(fitdistrplus)
library(actuar)
library(ADGofTest)
library (extRemes)
library (lmom)
library(gridExtra)
library(ggplot2)
var1<-rt(10000, df=1)
var2<-rt(10000, df=1)
var3<-rt(10000, df=1)
var4<-rt(10000, df=1)
df<-data.frame(var1,var2, var3, var4)
colnames(df)<-c("var1", "var2", "var3", "var4")
df<-data.frame(var1,var2, var3, var4)
colnames(df)<-c("var1", "var2", "var3", "var4")
pdf()
par(mfrow=c(2,2))
myFUN<-function(x, Name){
empi<-na.omit(x)
empi<-empi[which(empi>0)]
# Theoretical Pareto random series
par.par<-fitdist(empi, "pareto", start=list(shape = 1, scale = 500))
shape.par<-par.par$estimate[1]
scale.par<-par.par$estimate[2]
x.par<-rpareto(NROW(empi), shape.par,scale.par)
# Theoretical Weibull random series
par.wei<-fitdist(empi, "weibull")
shape.wei<-par.wei$estimate[1]
scale.wei<-par.wei$estimate[2]
x.wei<-rweibull(NROW(empi), shape.wei,scale.wei)
# Theoretical GEV random series
# Fittig EVD using the "extRemes" package (can't get it with fitdist)
par.gev <- fevd(empi,type =("GEV"),method=("Lmoments"))
loc.gev<-par.gev$results[1]
shape.gev<-par.gev$results[3]
scale.gev<-par.gev$results[2]
x.gev<-rgev(NROW(empi), loc=loc.gev, scale=scale.gev, shape=shape.gev)
# Create dataframe for using with ggplot+stat_ecdf
df<-data.frame(cbind(empi,rep("Empirical",times=NROW(empi))))
colnames(df)<-c("X","distr")
dfpar<-data.frame(cbind(x.par,rep("Pareto",times=NROW(x.par))))
colnames(dfpar)<-c("X","distr")
dfwei<-data.frame(cbind(x.wei,rep("Weibull",times=NROW(x.wei))))
colnames(dfwei)<-c("X","distr")
dfgev<-data.frame(cbind(x.gev,rep("GEV",times=NROW(x.gev))))
colnames(dfgev)<-c("X","distr")
df<-rbind(df,dfpar)
df<-rbind(df,dfwei)
df<-rbind(df,dfgev)
df$X<-as.numeric(levels(df$X))[df$X]
g<-ggplot(df, aes(X, colour = distr, linetype = distr)) + stat_ecdf(size=1)+theme_classic() +
scale_x_continuous(trans = 'log10')+scale_y_continuous(trans = 'log10') +
xlab("Daily returns")+ylab("CDFs") + ggtitle(Name) + theme(plot.title = element_text(hjust = 0.5)) +
theme(legend.position = c(0.85, 0.25), legend.text=element_text(size=12), legend.title=element_blank())
print(g)
}
allgraph<-mapply(myFUN, df, names(df), SIMPLIFY = FALSE)
dev.off()
按照@bdemarest 的建议，我返回到函数 gridExtra::marrangeGrob 并找到了一种方法：
library(evd)
library(MASS)
library(fitdistrplus)
library(actuar)
library(ADGofTest)
library (extRemes)
library (lmom)
library(gridExtra)
library(ggplot2)
var1<-rt(10000, df=1)
var2<-rt(10000, df=1)
var3<-rt(10000, df=1)
var4<-rt(10000, df=1)
df<-data.frame(var1,var2, var3, var4)
colnames(df)<-c("var1", "var2", "var3", "var4")
df<-data.frame(var1,var2, var3, var4)
colnames(df)<-c("var1", "var2", "var3", "var4")
myFUN<-function(x, Name){
empi<-na.omit(x)
empi<-empi[which(empi>0)]
# Theoretical Pareto random series
par.par<-fitdist(empi, "pareto", start=list(shape = 1, scale = 500))
shape.par<-par.par$estimate[1]
scale.par<-par.par$estimate[2]
x.par<-rpareto(NROW(empi), shape.par,scale.par)
# Theoretical Weibull random series
par.wei<-fitdist(empi, "weibull")
shape.wei<-par.wei$estimate[1]
scale.wei<-par.wei$estimate[2]
x.wei<-rweibull(NROW(empi), shape.wei,scale.wei)
# Theoretical GEV random series
# Fittig EVD using the "extRemes" package (can't get it with fitdist)
par.gev <- fevd(empi,type =("GEV"),method=("Lmoments"))
loc.gev<-par.gev$results[1]
shape.gev<-par.gev$results[3]
scale.gev<-par.gev$results[2]
x.gev<-rgev(NROW(empi), loc=loc.gev, scale=scale.gev, shape=shape.gev)
# Create dataframe for using with ggplot+stat_ecdf
df<-data.frame(cbind(empi,rep("Empirical",times=NROW(empi))))
colnames(df)<-c("X","distr")
dfpar<-data.frame(cbind(x.par,rep("Pareto",times=NROW(x.par))))
colnames(dfpar)<-c("X","distr")
dfwei<-data.frame(cbind(x.wei,rep("Weibull",times=NROW(x.wei))))
colnames(dfwei)<-c("X","distr")
dfgev<-data.frame(cbind(x.gev,rep("GEV",times=NROW(x.gev))))
colnames(dfgev)<-c("X","distr")
df<-rbind(df,dfpar)
df<-rbind(df,dfwei)
df<-rbind(df,dfgev)
df$X<-as.numeric(levels(df$X))[df$X]
ggplot(df, aes(X, colour = distr, linetype = distr)) + stat_ecdf(size=1)+theme_classic() +
scale_x_continuous(trans = 'log10')+scale_y_continuous(trans = 'log10') +
xlab("Daily returns")+ylab("CDFs") + ggtitle(Name) + theme(plot.title = element_text(hjust = 0.5)) +
theme(legend.position = c(0.85, 0.25), legend.text=element_text(size=8), legend.title=element_blank())
}
thecharts<-mapply(myFUN, df, names(df), SIMPLIFY = FALSE)
allthecharts<- marrangeGrob(thecharts, nrow=2, ncol=2)
ggsave("allthecharts.pdf", allthecharts)
之前，我错误地在 mapply 函数中添加了命令 g<-ggplot(df,...) print(g)，它给出了错误消息 Error in gList(var1 = list(data = list(list(colour = c("#F8766D", " #F8766D", : 在 "gList"
中只允许 'grobs'
我将一个变量的经验累积分布函数与 3 个理论累积分布函数进行比较。我对 150 个变量执行此操作，并希望将结果打印在一个 PDF 文件中，每页有 4 个图表。我不使用循环，而是使用 mapply。理想情况下，我可以使用 par(mfrow=c(2,2)) 但我认为这仅适用于 R 基础对象而不适用于 ggplot。我查看了 gridExtra 包 here 但没有找到如何继续。
library(evd)
library(MASS)
library(fitdistrplus)
library(actuar)
library(ADGofTest)
library (extRemes)
library (lmom)
library(gridExtra)
library(ggplot2)
var1<-rt(10000, df=1)
var2<-rt(10000, df=1)
var3<-rt(10000, df=1)
var4<-rt(10000, df=1)
df<-data.frame(var1,var2, var3, var4)
colnames(df)<-c("var1", "var2", "var3", "var4")
df<-data.frame(var1,var2, var3, var4)
colnames(df)<-c("var1", "var2", "var3", "var4")
pdf()
par(mfrow=c(2,2))
myFUN<-function(x, Name){
empi<-na.omit(x)
empi<-empi[which(empi>0)]
# Theoretical Pareto random series
par.par<-fitdist(empi, "pareto", start=list(shape = 1, scale = 500))
shape.par<-par.par$estimate[1]
scale.par<-par.par$estimate[2]
x.par<-rpareto(NROW(empi), shape.par,scale.par)
# Theoretical Weibull random series
par.wei<-fitdist(empi, "weibull")
shape.wei<-par.wei$estimate[1]
scale.wei<-par.wei$estimate[2]
x.wei<-rweibull(NROW(empi), shape.wei,scale.wei)
# Theoretical GEV random series
# Fittig EVD using the "extRemes" package (can't get it with fitdist)
par.gev <- fevd(empi,type =("GEV"),method=("Lmoments"))
loc.gev<-par.gev$results[1]
shape.gev<-par.gev$results[3]
scale.gev<-par.gev$results[2]
x.gev<-rgev(NROW(empi), loc=loc.gev, scale=scale.gev, shape=shape.gev)
# Create dataframe for using with ggplot+stat_ecdf
df<-data.frame(cbind(empi,rep("Empirical",times=NROW(empi))))
colnames(df)<-c("X","distr")
dfpar<-data.frame(cbind(x.par,rep("Pareto",times=NROW(x.par))))
colnames(dfpar)<-c("X","distr")
dfwei<-data.frame(cbind(x.wei,rep("Weibull",times=NROW(x.wei))))
colnames(dfwei)<-c("X","distr")
dfgev<-data.frame(cbind(x.gev,rep("GEV",times=NROW(x.gev))))
colnames(dfgev)<-c("X","distr")
df<-rbind(df,dfpar)
df<-rbind(df,dfwei)
df<-rbind(df,dfgev)
df$X<-as.numeric(levels(df$X))[df$X]
g<-ggplot(df, aes(X, colour = distr, linetype = distr)) + stat_ecdf(size=1)+theme_classic() +
scale_x_continuous(trans = 'log10')+scale_y_continuous(trans = 'log10') +
xlab("Daily returns")+ylab("CDFs") + ggtitle(Name) + theme(plot.title = element_text(hjust = 0.5)) +
theme(legend.position = c(0.85, 0.25), legend.text=element_text(size=12), legend.title=element_blank())
print(g)
}
allgraph<-mapply(myFUN, df, names(df), SIMPLIFY = FALSE)
dev.off()
按照@bdemarest 的建议，我返回到函数 gridExtra::marrangeGrob 并找到了一种方法：
library(evd)
library(MASS)
library(fitdistrplus)
library(actuar)
library(ADGofTest)
library (extRemes)
library (lmom)
library(gridExtra)
library(ggplot2)
var1<-rt(10000, df=1)
var2<-rt(10000, df=1)
var3<-rt(10000, df=1)
var4<-rt(10000, df=1)
df<-data.frame(var1,var2, var3, var4)
colnames(df)<-c("var1", "var2", "var3", "var4")
df<-data.frame(var1,var2, var3, var4)
colnames(df)<-c("var1", "var2", "var3", "var4")
myFUN<-function(x, Name){
empi<-na.omit(x)
empi<-empi[which(empi>0)]
# Theoretical Pareto random series
par.par<-fitdist(empi, "pareto", start=list(shape = 1, scale = 500))
shape.par<-par.par$estimate[1]
scale.par<-par.par$estimate[2]
x.par<-rpareto(NROW(empi), shape.par,scale.par)
# Theoretical Weibull random series
par.wei<-fitdist(empi, "weibull")
shape.wei<-par.wei$estimate[1]
scale.wei<-par.wei$estimate[2]
x.wei<-rweibull(NROW(empi), shape.wei,scale.wei)
# Theoretical GEV random series
# Fittig EVD using the "extRemes" package (can't get it with fitdist)
par.gev <- fevd(empi,type =("GEV"),method=("Lmoments"))
loc.gev<-par.gev$results[1]
shape.gev<-par.gev$results[3]
scale.gev<-par.gev$results[2]
x.gev<-rgev(NROW(empi), loc=loc.gev, scale=scale.gev, shape=shape.gev)
# Create dataframe for using with ggplot+stat_ecdf
df<-data.frame(cbind(empi,rep("Empirical",times=NROW(empi))))
colnames(df)<-c("X","distr")
dfpar<-data.frame(cbind(x.par,rep("Pareto",times=NROW(x.par))))
colnames(dfpar)<-c("X","distr")
dfwei<-data.frame(cbind(x.wei,rep("Weibull",times=NROW(x.wei))))
colnames(dfwei)<-c("X","distr")
dfgev<-data.frame(cbind(x.gev,rep("GEV",times=NROW(x.gev))))
colnames(dfgev)<-c("X","distr")
df<-rbind(df,dfpar)
df<-rbind(df,dfwei)
df<-rbind(df,dfgev)
df$X<-as.numeric(levels(df$X))[df$X]
ggplot(df, aes(X, colour = distr, linetype = distr)) + stat_ecdf(size=1)+theme_classic() +
scale_x_continuous(trans = 'log10')+scale_y_continuous(trans = 'log10') +
xlab("Daily returns")+ylab("CDFs") + ggtitle(Name) + theme(plot.title = element_text(hjust = 0.5)) +
theme(legend.position = c(0.85, 0.25), legend.text=element_text(size=8), legend.title=element_blank())
}
thecharts<-mapply(myFUN, df, names(df), SIMPLIFY = FALSE)
allthecharts<- marrangeGrob(thecharts, nrow=2, ncol=2)
ggsave("allthecharts.pdf", allthecharts)
之前，我错误地在 mapply 函数中添加了命令 g<-ggplot(df,...) print(g)，它给出了错误消息 Error in gList(var1 = list(data = list(list(colour = c("#F8766D", " #F8766D", : 在 "gList"