我有一个包含一些异常值的数据集，例如以下
x <- rnorm(1000,0,20)
x <- c(x, 500, -500)
如果我们将其绘制在线性 x 轴刻度上，我们会看到
histogram(x)
我使用这个有用的线程想出了一个很好的方法来把它放在对数刻度上： 如何在 R 中使用对数刻度来表示直方图的 y 轴？：
mat <- data.frame(x)
ggplot(ee, aes(x = xx)) + geom_histogram(colour="darkblue", size=1, fill="blue") + scale_x_log10()
但是，我希望第二个示例中的 x 轴标签与第一个示例的 x 轴标签相匹配，除了一种“负对数” - 即第一个刻度（从中心向左移动）可能是 -1，然后下一个可能是 -10，下一个是 -100，但都是等距的。那有意义吗？
我不确定我是否理解您的目标，但是当您想要一个类似对数的变换但有零或负值时，反双曲正弦变换asinh()通常是一个不错的选择。对于大值，它类似于对数，并为所有实值定义。有关讨论、详细信息和其他选项，请参阅Rob Hyndman 的博客和stats.stackexchange.com 上的这个问题。
如果这是一种可接受的方法，您可以为 ggplot 创建自定义比例。下面的代码演示了如何创建和使用自定义比例（带有自定义中断），以及 asinh() 转换的可视化。
library(ggplot2)
library(scales)
limits <- 100
step <- 0.005
demo <- data.frame(x=seq(from=-1*limits,to=limits,by=step))
asinh_trans <- function(){
trans_new(name = 'asinh', transform = function(x) asinh(x),
inverse = function(x) sinh(x))
}
ggplot(demo,aes(x,x))+geom_point(size=2)+
scale_y_continuous(trans = 'asinh',breaks=c(-100,-50,-10,-1,0,1,10,50,100))+
theme_bw()
ggplot(demo,aes(x,x))+geom_point(size=2)+
scale_x_continuous(trans = 'asinh',breaks=c(0,1,10,50,100))+
scale_y_log10(breaks=c(0,1,10,50,100))+ # zero won't plot
xlab("asinh() scale")+ylab("log10 scale")+
theme_bw()
意识到这个问题已经相当老了，我还是决定回答它，因为我遇到了完全相同的问题。
我看到上面的一些答案误解了你原来的问题。我认为这是一个有效的可视化问题，我在下面概述了我的解决方案，希望对其他人也有用。
我的方法是使用ggplot和创建自定义日志转换x和y轴（以及自定义中断生成器）
library(ggplot2)
library(scales)
# Create custom log-style x axis transformer (...,-10,-3,-1,0,1,3,10,...)
custom_log_x_trans <- function()
trans_new("custom_log_x",
transform = function (x) ( sign(x)*log(abs(x)+1) ),
inverse = function (y) ( sign(y)*( exp(abs(y))-1) ),
domain = c(-Inf,Inf))
# Custom log x breaker (...,-10,-3,-1,0,1,3,10,...)
custom_x_breaks <- function(x)
{
range <- max(abs(x), na.rm=TRUE)
return (sort( c(0,
sapply(0:log10(range), function(z) (10^z) ),
sapply(0:log10(range/3), function(z) (3*10^z) ),
sapply(0:log10(range), function(z) (-10^z) ),
sapply(0:log10(range/3), function(z) (-3*10^z) )
)))
}
# Create custom log-style y axis transformer (0,1,3,10,...)
custom_log_y_trans <- function()
trans_new("custom_log_y",
transform = function (x) ( log(abs(x)+1) ),
inverse = function (y) ( exp(abs(y))-1 ),
domain = c(0,Inf))
# Custom log y breaker (0,1,3,10,...)
custom_y_breaks <- function(x)
{
max_y <- length(x)
range <- max(abs(max_y), na.rm=TRUE)
return (sort( c(0,
sapply(0:log10(range), function(z) (10^z) ),
sapply(0:log10(range/3), function(z) (3*10^z) )
)))
}
ggplot(data=mat) +
geom_histogram(aes(x=x,fill=..count..),
binwidth = 1, color="black", size=0.1) +
scale_fill_gradient("Count", low = "steelblue", high = "red") +
coord_trans(x="custom_log_x",y="custom_log_y") +
scale_x_continuous(breaks = custom_x_breaks(mat$x)) +
scale_y_continuous(breaks = custom_y_breaks(mat$x)) +
theme(axis.text.x=element_text(angle=90,hjust=1,vjust=0.5)) +
theme_bw()
这给了我以下情节。
注意：
x增加，箱子变得越来越薄（对数变换的副作用）无论哪种情况，两个异常值都清晰可见。
我找到了一种作弊的方法。我说“作弊”，因为它实际上分别绘制了数据的负面和正面部分。因此，您无法比较负面和正面数据。但只能分别显示正负部分的分布。
问题之一是如果您的数据中的值为零，它将不会显示在图中。
reverselog_trans <- function(base = exp(1)) {
trans <- function(x) -log(x, base)
inv <- function(x) base^(-x)
trans_new(paste0("reverselog-", format(base)), trans, inv,
log_breaks(base = base),
domain = c(1e-100, Inf))
}
quartz();
dist1 <- ggplot(data=df.meltFUAC) +
geom_point(alpha=1,aes(x=deltaU.deltaUltrasensitivity,y=deltaF.deltaFitness,
colour=deltaF.w_c)) +
scale_x_continuous(name = expression(Delta * S[ult]),
limits=c(1e-7,1),trans = "log10",breaks=c(1e-01,1e-03,1e-05),
labels=c("1e-01","1e-03","1e-05")) +
scale_y_continuous(name = expression(paste(Delta, " Fitness")),trans = "log10",
limits = c(1e-7,1), breaks=c(1e-01,1e-03,1e-05),
labels=c("1e-01","1e-03","1e-05")) +
theme_bw() +
theme(legend.position = "none", axis.title.x=element_blank(),strip.background=element_blank(),
panel.border=element_rect(colour = "black"),panel.grid.major=element_blank(),
panel.grid.minor=element_blank(),plot.background=element_blank(),
plot.margin=unit(c(0,0,0,-11),"mm"))
dist2 <- ggplot(data=df.meltFUAC, aes(x=-deltaU.deltaUltrasensitivity,y=deltaF.deltaFitness,
colour=deltaF.w_c)) +
geom_point(alpha=1) +
scale_x_continuous(name = expression(Delta * sqrt(S[ult] %.% S[amp])),limits=c(1,1e-7),
trans = reverselog_trans(10),breaks=c(1e-01,1e-03,1e-05),
labels=c("-1e-01","-1e-03","-1e-05")) +
scale_y_continuous(name = expression(paste(Delta, " Fitness")),trans = "log10",
limits = c(1e-7,1), breaks=c(1e-01,1e-03,1e-05),
labels=c("1e-01","1e-03","1e-05")) +
theme_bw() +
theme(legend.position = "none",strip.background=element_blank(),panel.border=element_rect(colour = "black"),
axis.text.y=element_blank(), axis.ticks.y=element_blank(), axis.title.y=element_blank(),
axis.line.y=element_line(colour="black",size=1,linetype="solid"),axis.title.x=element_blank(),
panel.grid.major=element_blank(),panel.grid.minor=element_blank(),plot.background=element_blank(),
plot.margin=unit(c(0,-8,0,2.5),"mm"))
hist0 <- ggplot(data=df.meltFUAC, aes(deltaF.deltaFitness,fill=deltaF.w_c)) +
#geom_histogram(alpha = 0.5, aes(y=..density..),position = 'identity') +
geom_density(alpha = 0.5, aes(colour=deltaF.w_c)) +
scale_x_continuous(name = expression(paste(Delta, " Fitness")),
limits=c(1e-7,1),trans = "log10",breaks=c(1e-01,1e-03,1e-05),
labels=c("1e-01","1e-03","1e-05")) +
scale_y_continuous(name = "Density", limits=c(0,0.6)) +
theme_bw() +
theme(legend.position = "none", axis.title.x=element_blank(),strip.background=element_blank(),
axis.text.y=element_blank(), axis.ticks.y=element_blank(), axis.title.y=element_blank(),
axis.text.x=element_blank(), axis.ticks.x=element_blank(), axis.title.x=element_blank(),
panel.border=element_rect(colour = "black"),panel.grid.major=element_blank(),
panel.grid.minor=element_blank(),plot.background=element_blank(),
plot.margin=unit(c(0,5,2.5,-2.5),"mm")) +
coord_flip()
hist1 <- ggplot(data=df.meltFUAC, aes(deltaU.deltaUltrasensitivity,fill=deltaF.w_c)) +
#geom_histogram(alpha = 0.5, aes(y=..density..),position = 'identity') +
geom_density(alpha = 0.5, aes(colour=deltaF.w_c)) +
scale_x_continuous(name = expression(Delta * S[ult]),
limits=c(1e-7,1),trans = "log10",breaks=c(1e-01,1e-03,1e-05),
labels=c("1e-01","1e-03","1e-05")) +
scale_y_continuous(name = "Density", limits=c(0,0.6)) +
theme_bw() +
theme(legend.position = "none", axis.title.x=element_blank(),strip.background=element_blank(),
axis.text.y=element_blank(), axis.ticks.y=element_blank(), axis.title.y=element_blank(),
axis.text.x=element_blank(), axis.ticks.x=element_blank(), axis.title.x=element_blank(),
axis.line.x=element_line(colour="black",size=1,linetype="solid"),
panel.border=element_rect(colour = "black"),panel.grid.major=element_blank(),
panel.grid.minor=element_blank(),plot.background=element_blank(),
plot.margin=unit(c(5,0,-2.5,2),"mm"))
hist2 <- ggplot(data=df.meltFUAC, aes(-deltaU.deltaUltrasensitivity,fill=deltaF.w_c)) +
#geom_histogram(alpha = 0.5, aes(y=..density..),position = 'identity') +
geom_density(alpha = 0.5, aes(colour=deltaF.w_c)) +
scale_x_continuous(name = expression(Delta * S[ult]),limits=c(1,1e-7),
trans = reverselog_trans(10),breaks=c(1e-01,1e-03,1e-05),
labels=c("-1e-01","-1e-03","-1e-05")) +
scale_y_continuous(name = "Density", limits=c(0,0.6)) +
theme_bw() +
theme(legend.position = "none",strip.background=element_blank(),panel.border=element_rect(colour = "black"),
axis.text.y=element_blank(), axis.ticks.y=element_blank(), axis.title.y=element_blank(),
axis.text.x=element_blank(), axis.ticks.x=element_blank(), axis.title.x=element_blank(),
axis.line.y=element_line(colour="black",size=1,linetype="solid"),
axis.line.x=element_line(colour="black",size=1,linetype="solid"),
panel.grid.major=element_blank(),panel.grid.minor=element_blank(),plot.background=element_blank(),
plot.margin=unit(c(5,-8,-2.5,2.5),"mm"))
grid.newpage();
pushViewport(viewport(layout = grid.layout(3, 3, widths = unit(c(4,4,2),"null"),
heights=unit(c(2,7.5,0.5),"null"))));
vplayout <- function(x, y) viewport(layout.pos.row = x, layout.pos.col = y);
print(dist2, vp = vplayout(2, 1));
print(dist1, vp = vplayout(2, 2));
print(hist2, vp = vplayout(1, 1));
print(hist1, vp = vplayout(1, 2));
print(hist0, vp = vplayout(2, 3));
grid.text(expression(Delta * Ultrasensitivity),vp = vplayout(3,1:2),x = unit(0.55, "npc"),
y = unit(0.9, "npc"),gp=gpar(fontsize=12, col="black"));
dev.copy2pdf(file=sprintf("%s/_dist/dist_hist_deltaF_deltaU_wc_01vs10.pdf", resultDir));
dev.off();
这是它得到的图表（但您需要手动放置图例）：
或者更简单的：
reverselog_trans <- function(base = exp(1)) {
trans <- function(x) -log(x, base)
inv <- function(x) base^(-x)
trans_new(paste0("reverselog-", format(base)), trans, inv,
log_breaks(base = base),
domain = c(1e-100, Inf))
}
quartz();
hist1 <- ggplot(deltaF, aes(deltaFitness,fill=w_c)) + guides(fill=guide_legend(title=expression(omega[c]))) + geom_histogram(alpha = 0.5, aes(y=..density..),position = 'identity') + geom_density(alpha = 0.05, aes(colour=w_c)) + scale_x_continuous(name = expression(paste(Delta, " Fitness")),trans = "log10");
hist1 <- hist1 + scale_y_continuous(name = "Density", limits=c(0,1));
#hist1 <- hist1 + theme(panel.background=element_blank(),panel.border=element_blank(),axis.line.x=element_blank(),axis.line.y=element_line(colour="black",linetype="solid",size=1),axis.title.x=element_blank(),panel.grid.major=element_blank(),panel.grid.minor=element_blank(),plot.background=element_blank(),plot.margin=unit(c(5,5,0,5),"mm"));
hist1 <- hist1 + theme_bw();
hist1 <- hist1 + theme(strip.background=element_blank(),panel.border=element_rect(colour = "black"),axis.title.x=element_blank(),panel.grid.major=element_blank(),panel.grid.minor=element_blank(),plot.background=element_blank(),plot.margin=unit(c(5,5,0,5),"mm"));
hist1 <- hist1 + scale_color_discrete(name=expression(omega[c]));# + geom_vline(xintercept=0, colour="grey", size = 1);# + geom_hline(yintercept=0, colour="grey", size = 0.5);
hist2 <- ggplot(deltaU, aes(deltaUltrasensitivity,fill=w_c)) + geom_histogram(alpha = 0.5, aes(y=..density..),position = 'identity') + geom_density(alpha = 0.05, aes(colour=w_c)) + scale_x_continuous(name = expression(paste(Delta, " Ultrasensitivity")), limits=c(1e-7,1),trans = "log10",breaks=c(1e-01,1e-03,1e-05),labels=c("1e-01","1e-03","1e-05"));
hist2 <- hist2 + scale_y_continuous(name = "Density",limits=c(0,1)) ;#+ geom_vline(xintercept=0, colour="grey", size = 1);# + geom_hline(yintercept=0, colour="grey", size = 0.5);
#hist2 <- hist2 + theme(legend.position = "none", axis.title.x=element_blank(),panel.background=element_blank(),panel.border=element_blank(),panel.grid.major=element_blank(),panel.grid.minor=element_blank(),plot.background=element_blank(),plot.margin=unit(c(0,5,0,-7.5),"mm"));
hist2 <- hist2 + theme_bw();
hist2 <- hist2 + theme(legend.position = "none", axis.title.x=element_blank(),strip.background=element_blank(),panel.border=element_rect(colour = "black"),panel.grid.major=element_blank(),panel.grid.minor=element_blank(),plot.background=element_blank(),plot.margin=unit(c(0,5,0,-7.5),"mm"));
# + ggtitle("Positive part")
hist3 <- ggplot(deltaU, aes(-deltaUltrasensitivity,fill=w_c)) + geom_histogram(alpha = 0.5, aes(y=..density..),position = 'identity') + geom_density(alpha = 0.05, aes(colour=w_c)) + scale_x_continuous(name = expression(paste(Delta, " Ultrasensitivity")), limits=c(1,1e-7),trans = reverselog_trans(10),breaks=c(1e-01,1e-03,1e-05),labels=c("-1e-01","-1e-03","-1e-05"));
hist3 <- hist3 + scale_y_continuous(name = "Density", limits=c(0,1));# + geom_hline(yintercept=0, colour="black", size = 0.5);
#hist3 <- hist3 + theme(legend.position = "none",panel.background=element_blank(),axis.text.y=element_blank(), axis.ticks.y=element_blank(), axis.title.y=element_blank(),axis.line.y=element_line(colour="black",size=1,linetype="solid"),axis.title.x=element_blank(),panel.grid.major=element_blank(),panel.grid.minor=element_blank(),plot.background=element_blank(),plot.margin=unit(c(0,-7.5,0,5),"mm"));
hist3 <- hist3 + theme_bw();
hist3 <- hist3 + theme(legend.position = "none",strip.background=element_blank(),panel.border=element_rect(colour = "black"),axis.text.y=element_blank(), axis.ticks.y=element_blank(), axis.title.y=element_blank(),axis.line.y=element_line(colour="black",size=1,linetype="solid"),axis.title.x=element_blank(),panel.grid.major=element_blank(),panel.grid.minor=element_blank(),plot.background=element_blank(),plot.margin=unit(c(0,-7.5,0,5),"mm"));
# + ggtitle("Negative part")
grid.newpage();
pushViewport(viewport(layout = grid.layout(4, 2, widths = unit(c(5,5),"null"),heights=unit(c(4.6,0.4,4.6,0.4),"null"))));
vplayout <- function(x, y) viewport(layout.pos.row = x, layout.pos.col = y);
print(hist1, vp = vplayout(1, 1:2)); # key is to define vplayout
grid.text(expression(paste(Delta, " Fitness")),vp = vplayout(2,1:2),x = unit(0.5, "npc"), y = unit(0.9, "npc"),gp=gpar(fontsize=12, col="black"));
print(hist3, vp = vplayout(3, 1));
print(hist2, vp = vplayout(3, 2));
grid.text(expression(paste(Delta, " Ultrasensitivity")),vp = vplayout(4,1:2),x = unit(0.5, "npc"), y = unit(0.9, "npc"),gp=gpar(fontsize=12, col="black"));
dev.copy2pdf(file=sprintf("%s/deltaF_deltaU_wc_01vs10.pdf", resultDir));
dev.off();
这是我得到的图表：
为什么要忍受 ggplot2 解决方案？您的第一个绘图是使用 latticehistogram函数完成的，这就是您应该停留的地方。只需在函数内直接应用对数变换histogram，使用nint参数指定直方图箱的数量，并使用type参数在“计数”或“密度”之间进行选择。我认为你在那里得到了你需要的一切，但也许我错过了你问题的一些关键细节......
library(lattice)
histogram(log10(x), nint=50, type="count")
