直方图与R“负”对数刻度(Histogram with “negative” logarithmic

我有一些异常，如下面的数据集

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轴标签以匹配第一示例的，除了与一种“负对数”的 - 即，第一蜱（从中心向左移动）可以是-1，则接下来可能是-10，未来-100，但都等距。 那有意义吗？

Answer 1:

我不知道我理解你的目标，但是当你想要一个日志般的改造还具有零或负值，反双曲正弦变换asinh()往往是一个不错的选择。 这是对数像大值和所有真正的价值定义。 见罗布海德门的博客 ，并在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()

Answer 2:

认识到这个问题是相当老了，我决定无论如何要回答这个问题，因为我遇到了一模一样的问题。

我看到上面一些答案误解你原来的问题。 我认为这是一个有效的可视化的问题，我在下面简要说明我的解决方案，希望能为别人有用。

我的方法是使用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增加（的副作用对数变换）

在这两种情况下， 这两个异常都清晰可见 。

Answer 3:

我发现了一个方法来欺骗它。 我说“欺骗”，因为它实际上分别绘制数据的消极和积极的部分。 因此，你不能比较消极和积极的数据。 但是，只有可以分别显示的消极和积极零件分布。

而问题之一是如果在你的数据零个值，它不会在图中显示。

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();

这是我得到的图：

Answer 4:

为什么要与GGPLOT2解决受苦？ 你的第一个情节与晶格做histogram功能，这是你应该留下来。 只需直接在应用对数变换histogram功能，使用nint参数指定直方图仓的数量和type参数“计数”之间进行选择，或“密度”。 我认为，你有你需要的任何东西，但也许我失去了你的问题的一些关键细节...

library(lattice)
histogram(log10(x), nint=50, type="count")

文章来源: Histogram with “negative” logarithmic scale in R