मैं अंदर की तरफ वाई-अक्ष और एक्स-अक्ष लेबल दोनों के साथ एक ggplot2 बनाना चाहता हूं, यानी, अंदर की तरफ और प्लॉट क्षेत्र के अंदर रखा गया है।

यह पिछले SO उत्तर द्वारा Z.Lin इसे y-अक्ष के मामले में हल करता है, और मुझे यह ठीक काम कर रहा है। लेकिन उस दृष्टिकोण को दोनों कुल्हाड़ियों तक विस्तारित करने से मैं स्तब्ध रह गया हूं। grobs कठिन है, मुझे लगता है।

इसलिए मैंने y-अक्ष के बजाय x-अक्ष के लिए काम करने के लिए Z.Lin के कोड को अनुकूलित करके छोटी शुरुआत करने का प्रयास किया, लेकिन मैं इसे हासिल करने में सक्षम नहीं हूं। grobs वास्तव में जटिल है। मेरा प्रयास (नीचे) grid.draw() तक त्रुटियों/चेतावनियों के बिना चलता है, जहां यह दुर्घटनाग्रस्त हो जाता है और जल जाता है (मुझे लगता है कि मैं कहीं कुछ तर्कों का दुरुपयोग कर रहा हूं, लेकिन मैं यह नहीं पहचान सकता कि कौन सा और इस बिंदु पर मैं सिर्फ अनुमान लगा रहा हूं) .

# locate the grob that corresponds to x-axis labels
x.label.grob <- gp$grobs[[which(gp$layout$name == "axis-b")]]$children$axis

# remove x-axis labels from the plot, & shrink the space occupied by them
gp$grobs[[which(gp$layout$name == "axis-b")]] <- zeroGrob()
gp$widths[gp$layout$l[which(gp$layout$name == "axis-b")]] <- unit(0, "cm")

# create new gtable
new.x.label.grob <- gtable::gtable(widths = unit(1, "npc"))
# place axis ticks in the first row
new.x.label.grob <- 
   gtable::gtable_add_rows(
      new.x.label.grob,
      heights = x.label.grob[["heights"]][1])
new.x.label.grob <- 
   gtable::gtable_add_grob(
      new.x.label.grob,
      x.label.grob[["grobs"]][[1]],
      t = 1, l = 1)
# place axis labels in the second row
new.x.label.grob <- 
   gtable::gtable_add_rows(
      new.x.label.grob,
      heights = x.label.grob[["heights"]][2])
new.x.label.grob <- 
   gtable::gtable_add_grob(
      new.x.label.grob,
      x.label.grob[["grobs"]][[2]],
      t = 1, l = 2)
# add third row that takes up all the remaining space
new.x.label.grob <- 
   gtable::gtable_add_rows(
      new.x.label.grob,
      heights = unit(1, "null"))

gp <- 
   gtable::gtable_add_grob(
      x = gp,
      grobs = new.x.label.grob,
      t = gp$layout$t[which(gp$layout$name == "panel")],
      l = gp$layout$l[which(gp$layout$name == "panel")])
grid.draw(gp)
# Error in unit(widths, default.units) : 
#  'x' and 'units' must have length > 0

मुझे लगता है कि मेरे प्रश्न को तीन अर्ध-स्वतंत्र भागों में विभाजित किया जा सकता है, जहां प्रत्येक बाद का प्रश्न पहले वाले प्रश्न का स्थान लेता है (इसलिए यदि आप बाद के प्रश्न का उत्तर दे सकते हैं, तो पहले वाले प्रश्नों से परेशान होने की कोई आवश्यकता नहीं होगी):

  • क्या कोई मौजूदा उत्तर को x-अक्ष के अनुकूल बना सकता है?
  • क्या कोई उस नस में दोनों कुल्हाड़ियों को अंदर लाने के लिए कोड प्रदान कर सकता है?
  • क्या किसी को ggplot2 के लिए दोनों कुल्हाड़ियों को प्राप्त करने के लिए एक साफ-सुथरा तरीका पता है?

यहाँ मेरा MWE है (ज्यादातर Z.Lin के उत्तर की नकल कर रहा है, लेकिन नए डेटा के साथ):

library(dplyr)
library(magrittr)
library(ggplot2)
library(grid)
library(gtable)
library(errors)
df <- structure(list(
   temperature = c(200, 300, 400, 500, 600, 700, 800, 900), 
   diameter = 
      structure(
         c(13.54317, 10.32521, 10.23137, 17.90464, 29.98183, 55.65514, 101.60747, 147.3074), 
         id = "<environment>", 
         errors = c(1.24849, 0.46666, 0.36781, 0.48463, 0.94639, 1.61459, 6.98346, 12.18353), 
         class = "errors")), 
   row.names = c(NA, -8L), 
   class = "data.frame")
p <- ggplot() +
   geom_smooth(data = df %>% filter(temperature >= 400),
               aes(x = temperature, y = diameter),
               method = "lm", formula = "y ~ x",
               se = FALSE, fullrange = TRUE) +
   # experimental errors as red ribbon (instead of errorbars)
   geom_ribbon(data = df,
               aes(x = temperature, 
                   ymin = errors_min(diameter), 
                   ymax = errors_max(diameter)), 
               fill = alpha("red", 0.2),
               colour = alpha("red", 0.2)) +
   geom_point(data = df,
              aes(x = temperature, y = diameter),
              size = 0.7) +
   geom_line(data = df,
             aes(x = temperature, y = diameter),
             size = 0.15) +
   scale_x_continuous(breaks = seq(200, 900, 200)) +
   scale_y_log10(breaks = c(10, seq(30, 150, 30)),
                 labels = c("10", "30", "60", "90", "120", "150=d/nm")) +
   theme(panel.grid.major = element_blank(), 
         panel.grid.minor = element_blank(), 
         axis.title.y = element_blank(),
         axis.text.y = element_text(hjust = 0))
# convert from ggplot to grob object
gp <- ggplotGrob(p)
y.label.grob <- gp$grobs[[which(gp$layout$name == "axis-l")]]$children$axis
gp$grobs[[which(gp$layout$name == "axis-l")]] <- zeroGrob()
gp$widths[gp$layout$l[which(gp$layout$name == "axis-l")]] <- unit(0, "cm")
new.y.label.grob <- gtable::gtable(heights = unit(1, "npc"))
new.y.label.grob <- 
   gtable::gtable_add_cols(
      new.y.label.grob,
      widths = y.label.grob[["widths"]][2])
new.y.label.grob <- 
   gtable::gtable_add_grob(
      new.y.label.grob,
      y.label.grob[["grobs"]][[2]],
      t = 1, l = 1)
new.y.label.grob <- 
   gtable::gtable_add_cols(
      new.y.label.grob,
      widths = y.label.grob[["widths"]][1])
new.y.label.grob <- 
   gtable::gtable_add_grob(
      new.y.label.grob,
      y.label.grob[["grobs"]][[1]],
      t = 1, l = 2)
new.y.label.grob <- 
   gtable::gtable_add_cols(
      new.y.label.grob,                                    
      widths = unit(1, "null"))
gp <- 
   gtable::gtable_add_grob(
      x = gp,
      grobs = new.y.label.grob,
      t = gp$layout$t[which(gp$layout$name == "panel")],
      l = gp$layout$l[which(gp$layout$name == "panel")])
grid.draw(gp)

enter image description here

> sessionInfo()
R version 3.6.2 (2019-12-12)
Platform: x86_64-pc-linux-gnu (64-bit)
Running under: Ubuntu 18.04.5 LTS

Matrix products: default
BLAS:   /usr/lib/x86_64-linux-gnu/blas/libblas.so.3.7.1
LAPACK: /usr/lib/x86_64-linux-gnu/lapack/liblapack.so.3.7.1

locale:
 [1] LC_CTYPE=en_GB.UTF-8       LC_NUMERIC=C              
 [3] LC_TIME=en_GB.UTF-8        LC_COLLATE=en_GB.UTF-8    
 [5] LC_MONETARY=en_GB.UTF-8    LC_MESSAGES=en_GB.UTF-8   
 [7] LC_PAPER=en_GB.UTF-8       LC_NAME=C                 
 [9] LC_ADDRESS=C               LC_TELEPHONE=C            
[11] LC_MEASUREMENT=en_GB.UTF-8 LC_IDENTIFICATION=C       

attached base packages:
[1] grid      stats     graphics  grDevices utils     datasets  methods  
[8] base     

other attached packages:
[1] errors_0.3.4  gtable_0.3.0  ggplot2_3.3.2 magrittr_1.5  dplyr_1.0.2  

loaded via a namespace (and not attached):
 [1] rstudioapi_0.11  splines_3.6.2    tidyselect_1.1.0 munsell_0.5.0   
 [5] lattice_0.20-41  colorspace_1.4-1 R6_2.5.0         rlang_0.4.8     
 [9] tools_3.6.2      nlme_3.1-148     mgcv_1.8-31      withr_2.3.0     
[13] ellipsis_0.3.1   digest_0.6.27    yaml_2.2.1       tibble_3.0.4    
[17] lifecycle_0.2.0  crayon_1.3.4     Matrix_1.2-18    purrr_0.3.4     
[21] farver_2.0.3     vctrs_0.3.4      glue_1.4.2       compiler_3.6.2  
[25] pillar_1.4.6     generics_0.1.0   scales_1.1.1     pkgconfig_2.0.3 
1
solarchemist 28 नवम्बर 2020, 02:41

2 जवाब

सबसे बढ़िया उत्तर

प्लॉट को ग्रोब ट्री के रूप में "फ्रीजिंग" करने और फिर ग्रोब्स को हैक करने के बजाय, मैंने सोचा कि यह देखना उपयोगी हो सकता है कि हम कुल्हाड़ियों को कैसे अंदर ले जा सकते हैं लेकिन ऑब्जेक्ट को जीजीप्लॉट के रूप में रख सकते हैं। ऐसा करने का तरीका एक ऐसा फ़ंक्शन लिखना है जो आपकी साजिश लेता है, आवश्यक जानकारी निकालता है, फिर कुल्हाड़ियों का निर्माण करता है और उन्हें एनोटेशन के रूप में जोड़ता है।

लौटाई गई वस्तु एक सामान्य ggplot है, जिसमें आप परतों, तराजू को जोड़ सकते हैं और विषयों को सामान्य रूप से संशोधित कर सकते हैं:

move_axes_inside <- function(p)
{
  b <- ggplot_build(p)
  x_breaks <- b$layout$panel_scales_x[[1]]$break_info()
  y_breaks <- b$layout$panel_scales_y[[1]]$break_info()
  x_range <- b$layout$panel_params[[1]]$x.range
  y_range <- b$layout$panel_params[[1]]$y.range
  y_breaks$major <- diff(y_breaks$range)/diff(y_range) * y_breaks$major + 
    (y_breaks$range[1] - y_range[1])/diff(y_range)
  x_breaks$major <- diff(x_breaks$range)/diff(x_range) * x_breaks$major + 
    (x_breaks$range[1] - x_range[1])/diff(x_range)
  y <- grid::yaxisGrob(at = y_breaks$major, label = y_breaks$labels, main = FALSE)
  x <- grid::xaxisGrob(at = x_breaks$major, label = x_breaks$labels, main = FALSE)
  p + annotation_custom(y, xmin = x_range[1], xmax = x_range[1]) +
      annotation_custom(x, ymin = y_range[1], ymax = y_range[1]) +
      theme(axis.text.y = element_blank(),
            axis.ticks = element_blank(),
            axis.text.x = element_blank())
    
}

तो अपने प्लॉट के साथ इसका परीक्षण हमें मिलता है:

p2 <- move_axes_inside(p)
 
p2

enter image description here

और हम विषय तत्वों आदि को बदल सकते हैं:

p2 + theme(panel.grid.major = element_line())

enter image description here

असतत कुल्हाड़ियों आदि के साथ काम करने के लिए इसे थोड़ा विकास और परीक्षण की आवश्यकता होगी, लेकिन इसे मनमाने ढंग से निरंतर अक्षों के लिए काम करना चाहिए।

1
Allan Cameron 30 नवम्बर 2020, 07:09

यदि कोई अन्य व्यक्ति ggplot2 का उपयोग करके एक कॉम्पैक्ट प्लॉट बनाने का तरीका ढूंढ रहा है, उदाहरण के लिए पेज मार्जिन के अंदर प्लेसमेंट के लिए, तो शायद मुझे पूर्ण कोड द्वारा काफी प्रकाशन-तैयार-मार्जिन के लिए मदद मिलेगी उपरोक्त उत्तर में एलन कैमरून के सुरुचिपूर्ण दृष्टिकोण द्वारा साजिश को संभव बनाया गया।

प्लॉट को पेज मार्जिन के अंदर रखना आमतौर पर उचित नहीं है, और यह उपलब्ध मार्जिन, दस्तावेज़ के प्रकार आदि पर निर्भर करता है। किसी भी मामले में, प्लॉट को अव्यवस्था मुक्त और स्ट्रीम-लाइन जितना संभव हो उतना स्मार्ट बनाना संभव है। इसलिए, मेरे मामले में, मैं पैनल के पदचिह्न के अंदर अधिक से अधिक प्लॉट रखने का एक तरीका ढूंढ रहा था, इसलिए बोलने के लिए।

पर्याप्त पृष्ठभूमि, यहाँ कोड है:

library(dplyr)
library(magrittr)
library(ggplot2)
library(grid)
library(gtable)
library(errors)
theme_set(theme_grey())

move_axes_inside <- function(p) {
   b <- ggplot_build(p)
   x_breaks <- b$layout$panel_scales_x[[1]]$break_info()
   y_breaks <- b$layout$panel_scales_y[[1]]$break_info()
   x_range <- b$layout$panel_params[[1]]$x.range
   y_range <- b$layout$panel_params[[1]]$y.range
   y_breaks$major <- 
      diff(y_breaks$range) / diff(y_range) * y_breaks$major + 
      (y_breaks$range[1] - y_range[1]) / diff(y_range)
   x_breaks$major <- 
      diff(x_breaks$range) / diff(x_range) * x_breaks$major + 
      (x_breaks$range[1] - x_range[1]) / diff(x_range)
   y <- 
      grid::yaxisGrob(
         at = y_breaks$major, 
         label = y_breaks$labels, 
         gp = 
            gpar(
               lwd = 1, # line width of axis and tick marks
               fontsize = 8,
               cex = 0.8, # multiplier to font size
               lineheight = 0.8), # tick mark length
         main = FALSE)
   x <- 
      grid::xaxisGrob(
         at = x_breaks$major, 
         label = x_breaks$labels, 
         gp = 
            gpar(
               lwd = 2, # draw axis with thicker line width
               fontsize = 8,
               cex = 0.8, # multiplier to font size
               lineheight = 0.8), # tick mark length
         main = FALSE)
   p <- 
      p + 
      annotation_custom(
         # draw y-axis, shifted slightly inwards (so that axis is inside panel.border)
         grob = y, 
         xmin = x_range[1] + 0.01 * diff(x_range), 
         xmax = x_range[1] + 0.01 * diff(x_range)) +
      annotation_custom(
         grob = x, 
         ymin = y_range[1] + 0.01 * diff(y_range),
         ymax = y_range[1] + 0.01 * diff(y_range)) +
      theme(
         axis.ticks = element_blank(),
         axis.title.y = element_blank(),
         axis.text.y = element_blank(),
         axis.text.x = element_blank())
   return(p)
}

p <- ggplot() +
   geom_line(
      stat = "smooth", method = lm, formula = "y ~ x",
      se = FALSE, fullrange = TRUE,
      data = df %>% filter(temperature >= 400),
      aes(x = temperature, y = diameter),
      colour = "blue", size = 2, alpha = 0.35) +
   # experimental errors as red ribbon (instead of errorbars)
   geom_ribbon(
      data = df,
      aes(x = temperature, 
          ymin = errors_min(diameter), 
          ymax = errors_max(diameter)), 
      fill = alpha("red", 0.25),
      colour = NA) +
   # data points excluded in linear fit
   geom_point(
      data = df %>% filter(temperature < 400),
      aes(x = temperature, y = diameter),
      # by default, shape=19 (filled circle)
      # https://blog.albertkuo.me/post/point-shape-options-in-ggplot/
      # I'd like a solid circle, so shape 16 it is
      size = 1.2, shape = 16, colour = alpha("red", 0.25)) +
   # data points included in linear fit
   geom_point(
      data = df %>% filter(temperature >= 400),
      aes(x = temperature, y = diameter),
      size = 1.2, shape = 16, colour = alpha("red", 0.45)) +
   # I ended up putting the x-axis unit label on the outside because 
   # however I tried, it would not fit inside and I was not able to 
   # rotate the x-axis labels on the inside.
   labs(x = "$T_\\mathrm{a}/\\si{\\celsius}$") +
   scale_x_continuous(
      breaks = seq(200, 900, 100),
      # first element can't be empty string - if so then all labels dont print (weird bug?)
      labels = c(" ", " ", "400", " ", "600", " ", "800", " ")) +
   scale_y_log10(
      breaks = c(10, 50, 90, 130),
      labels = c("\\num{10}", "\\num{50}", "\\num{90}", "$\\num{130}=d/\\si{\\nm}$")) +
   # note that we set some theme settings inside the move_axes_inside() function
   theme(
      # l = -1 was required to completely fill the space with plot panel
      # b = 0 because we are making room for x-axis title on the outside
      plot.margin = margin(t = 0, r = 0, b = 0, l = -1, "mm"),
      # smaller text size in x-axis title, trying to conform with fontsize inside axis
      # vjust moves the title closer to the x-axis line, value optimised optically
      axis.title.x = element_text(size = 8 * 0.8, vjust = 2.0),
      # grid lines just look busy in such a small plot
      panel.grid.major = element_blank(),
      panel.grid.minor = element_blank())

move_axes_inside(p)

यहां परिणाम का एक स्क्रीन-शॉट है, जो कि निट्र और लाटेक्स के साथ संकलित दस्तावेज़ में और \marginpar{} के अंदर प्लॉट के साथ है: यहां छवि विवरण दर्ज करें

1
solarchemist 30 नवम्बर 2020, 07:13