Add another x axis underneath the original

General
#1

(I've posted the same question on SO, not sure if there are rules against that or not?)

Example:

diamonds %>% 
  ggplot(aes(scale(price) %>% as.vector)) +
  geom_density() +
  xlim(-3, 3) +
  facet_wrap(vars(cut))

Returns a plot:

image
image674×593 14.4 KB

Since I used scale, those numbers are the zscores or standard deviations away from the mean of each break.

I would like to add as a row underneath the equivalent non scaled raw number that corresponds to each.

e.g. diamonds$price %>% log %>% mean %>% exp (i.e. the exp transformed Geo mean) would go underneath the middle at break 0.

Tried:

diamonds %>% 
  ggplot(aes(scale(price) %>% as.vector)) +
  geom_density() +
  xlim(-3, 3) +
  facet_wrap(vars(cut)) +
  geom_text(aes(label = price))

Gives:

Error: geom_text requires the following missing aesthetics: y

I then tried changing my call to geom_text()

  geom_text(data = diamonds, aes(price), label = price)

This results in the same error message.

My primary question is how can I add the raw values underneath -3:3 of each break? I don't want to change those breaks, I still want 6 breaks between -3:3.

Secondary question, how can I get -3 and 3 to actually show up in the chart? They have been trimmed.

#2

Here is an approach to getting the numbers up top.

(diamonds2 <- mutate(diamonds,
  scale_price = scale(price) %>% as.numeric()
))
lm1 <- lm(price ~ scale_price, data = diamonds2)

diamonds2 %>%
  ggplot(aes(x = scale_price)) +
  geom_density() +
  coord_fixed(xlim = c(-3, 3)) +
  scale_x_continuous(breaks = -3:3, 
                     sec.axis = sec_axis(~ . * lm1$coefficients[[1]] + lm1$coefficients[[2]],
    guide = guide_axis(position = "top"),
    breaks = (-1:4) * 5000
  )) +
  facet_wrap(vars(cut), ncol = 2)
#3

Thanks for the suggestion, I get an error message when trying this:
diamnonds2 and lm1 are fine, but:

diamonds2 %>%
  ggplot(aes(x = scale_price)) +
  geom_density() +
  coord_fixed(xlim = c(-3, 3)) +
  scale_x_continuous(breaks = -3:3, 
                     sec.axis = sec_axis(~ . * lm1$coefficients[[1]] + lm1$coefficients[[2]],
                                         guide = guide_axis(position = "top"),
                                         breaks = (-1:4) * 5000
                     )) +
  facet_wrap(vars(cut), ncol = 2)

Error in sec_axis(~. * lm1$coefficients[[1]] + lm1$coefficients[[2]], :
unused argument (guide = guide_axis(position = "top"))

#4

interesting, perhaps a version issue.
What do you get when you run

args(sec_axis)
#5 
args(sec_axis)
function (trans = NULL, name = waiver(), breaks = waiver(), labels = waiver()) 
NULL
#6

full console output:

(diamonds2 <- mutate(diamonds,
+                      scale_price = scale(price) %>% as.numeric()
+ ))
# A tibble: 53,940 x 12
   carat cut       color clarity depth table price     x     y     z price_scaled scale_price
   <dbl> <ord>     <ord> <ord>   <dbl> <dbl> <int> <dbl> <dbl> <dbl>        <dbl>       <dbl>
 1 0.23  Ideal     E     SI2      61.5    55   326  3.95  3.98  2.43       -0.904      -0.904
 2 0.21  Premium   E     SI1      59.8    61   326  3.89  3.84  2.31       -0.904      -0.904
 3 0.23  Good      E     VS1      56.9    65   327  4.05  4.07  2.31       -0.904      -0.904
 4 0.290 Premium   I     VS2      62.4    58   334  4.2   4.23  2.63       -0.902      -0.902
 5 0.31  Good      J     SI2      63.3    58   335  4.34  4.35  2.75       -0.902      -0.902
 6 0.24  Very Good J     VVS2     62.8    57   336  3.94  3.96  2.48       -0.902      -0.902
 7 0.24  Very Good I     VVS1     62.3    57   336  3.95  3.98  2.47       -0.902      -0.902
 8 0.26  Very Good H     SI1      61.9    55   337  4.07  4.11  2.53       -0.901      -0.901
 9 0.22  Fair      E     VS2      65.1    61   337  3.87  3.78  2.49       -0.901      -0.901
10 0.23  Very Good H     VS1      59.4    61   338  4     4.05  2.39       -0.901      -0.901
# … with 53,930 more rows
> lm1 <- lm(price ~ scale_price, data = diamonds2)
> 
> diamonds2 %>%
+   ggplot(aes(x = scale_price)) +
+   geom_density() +
+   coord_fixed(xlim = c(-3, 3)) +
+   scale_x_continuous(breaks = -3:3, 
+                      sec.axis = sec_axis(~ . * lm1$coefficients[[1]] + lm1$coefficients[[2]],
+                                          guide = guide_axis(position = "top"),
+                                          breaks = (-1:4) * 5000
+                      )) +
+   facet_wrap(vars(cut), ncol = 2)
Error in sec_axis(~. * lm1$coefficients[[1]] + lm1$coefficients[[2]],  : 
  unused argument (guide = guide_axis(position = "top"))
> args(sec_axis)
function (trans = NULL, name = waiver(), breaks = waiver(), labels = waiver()) 
NULL
#7

I think that the guide param was added in the latest version of ggplot2 . so , you could try it without that and see what happens, or try to install the latest.
First restart R with Ctrl+Shift+F10 then

update.packages(oldPkgs = "ggplot2")
#8

This works now. Thank you for the suggestion. I was hoping to find a way to display it underneath the existing horizontal axis. I tried following the solution over here but could not get it to work with this example. Do you know how?

#9 
(diamonds2 <- mutate(diamonds,
                     scale_price = scale(price) %>% as.numeric()
))
lm1 <- lm(price ~ scale_price, data = diamonds2)

text_labels <- data.frame(
  x=-3:3,
  y=1, # height of text
  lab= as.character(round((-3:3) * lm1$coefficients[[1]] + lm1$coefficients[[2]],digits=0))
)

 
diamonds2 %>%
  ggplot(aes(x = scale_price)) +
  geom_density() +
  coord_fixed(xlim = c(-3, 3),clip = "off") +
  geom_text(data=text_labels,
            mapping=aes(x=x,y=y,label=lab),vjust=6,
            size=3)+
  geom_text(data=text_labels,
            mapping=aes(x=x,y=y,label=x),vjust=7.5,
            size=3)+
  facet_wrap(vars(cut), ncol = 2)+ theme(panel.spacing = unit(2, "lines"),
                                         axis.line.x = element_blank(),
                                         axis.text.x = element_blank(),
                                         axis.title.x = element_blank())

image
image990×696 79.5 KB

1 Like
#10

This is great, thank you

#11

This topic was automatically closed 7 days after the last reply. New replies are no longer allowed.