Question

我有以下情节

plot

p1<-ggplot(data.frame(x=c(-10, 30),y=c(0,250)), aes(x,y))
p1<-p1 +stat_function(fun=function(x)12+180/(1+exp(-.759*(x-7.69))),size = 2,color="yellow")+coord_cartesian(ylim=c(0, 250))+geom_abline(intercept = 44, slope = 0,lty=2)+scale_x_continuous(limits=c(-5,25))+ geom_ribbon(aes(ymin=0, ymax=80))
print(p1)

我正在尝试更改轴，使虚线上方的部分“压扁”，虚线下方的部分得到扩展（但不更改轴）。换句话说，我希望绘图下部的比例更宽，上部的比例更窄，以便更明显地显示虚线下方的部分。但是，我似乎无法弄清楚如何做到这一点。有什么建议吗？

感谢。

Answer 1

我希望我已经正确理解了你需要的东西。

我不知道@ 42-评论是什么，但我认为协调转换绝对是可行的方法。

library(scales)
magnify_trans <- function(intercept, reducer) {

    trans <- function(x, i = intercept, r = reducer) {
        sapply(x, function(x) {
            if (x < i) x
            else x / r + i
        })
    }

    inv <- function(x, i = intercept, r = reducer) {
        sapply(x, function(x) {
            if(!is.na(x)) {
                if (x < i) x
                else (x - i) * r
            }
        })
    }

    trans_new(name = 'custom',
              transform = trans,
              inverse = inv
              )
}

我们定义了transformation，将intercept以上的值除以reducer arg。

library(ggplot2)
ggplot(data.frame(x = c(-10, 30), y = c(0, 250)), aes(x, y)) +
    stat_function(fun = function(x) 12 + 180 / (1 + exp(-.759*(x - 7.69))),
                  size = 2,
                  color = "yellow") +
    coord_cartesian(ylim = c(0, 250))+
    geom_abline(intercept = 44, slope = 0, lty = 2)+
    scale_x_continuous(limits = c(-5, 25)) +
    coord_trans(y = magnify_trans(intercept = 44, reducer = 20))

如果你想要的话，可以在x轴上使用相同的转换：

ggplot(data.frame(x = c(-10, 30), y = c(0, 250)), aes(x, y)) +
    stat_function(fun = function(x) 12 + 180 / (1 + exp(-.759 * (x - 7.69))),
                  size = 2,
                  color = "yellow") +
    coord_cartesian(ylim = c(0, 250))+
    geom_abline(intercept = 44, slope = 0, lty = 2)+
    scale_x_continuous(limits = c(-5, 25)) +
    coord_trans(x = magnify_trans(intercept = 5.675, reducer = 20))

Answer 2

这是对间隔外压缩的概括。我希望它对某人有用。

magnify_trans <- function(interval_low = 0, interval_high = 7,  reducer = 20) {

    trans <- function(x, i_low = interval_low, i_high = interval_high, r = reducer) 
        sapply(x, function(x) {
            if(x >= i_low & x <= i_high ) x
            else if(x < i_low) x / r + i_low
            else (x - i_high) / r + i_high
        })

    inv <- function(x, i_low = interval_low, i_high = interval_high, r = reducer) 
        sapply(x, function(x) {
            if(x >= i_low & x <= i_high ) x
            else if(x < i_low) (x - i_low) * r
            else ((x - i_high) * r) + i_high
        })

    trans_new(name = 'custom',  transform = trans,inverse = inv )
}

压缩ggplot中的轴

2 个答案: