2016-06-23 13 views
1

Ich benutze facet_wrap und konnte auch die sekundäre y-Achse darstellen. Die Beschriftungen werden jedoch nicht in der Nähe der Achse gezeichnet, sondern sehr weit geplottet. Mir ist klar, dass alles gelöst werden wird, wenn ich verstehe, wie man das Koordinatensystem des Gitables (t, b, l, r) der Grobs manipuliert. Könnte jemand erklären, wie und was sie tatsächlich darstellen - t: r = c (4,8,4,4) bedeutet was.Wie man die Koordinaten t, b, l, r von gtable() verwaltet, um die Beschriftungen und Teilstriche der sekundären y-Achse richtig zu zeichnen

Es gibt viele Links für sekundäre yaxis mit ggplot, aber wenn nrow/ncol mehr als 1 ist, scheitern sie. Also bitte bring mir die Grundlagen der Grid-Geometrie und Grob-Location-Management bei.

Edit: der Kodex

this is the final code written by me : 

library(ggplot2) 
library(gtable) 
library(grid) 
library(data.table) 
library(scales) 

# Data 
diamonds$cut <- sample(letters[1:13], nrow(diamonds), replace = TRUE) 
dt.diamonds <- as.data.table(diamonds) 
d1 <- dt.diamonds[,list(revenue = sum(price), 
        stones = length(price)), 
       by=c("clarity", "cut")] 
setkey(d1, clarity, cut) 

# The facet_wrap plots 
p1 <- ggplot(d1, aes(x = clarity, y = revenue, fill = cut)) + 
geom_bar(stat = "identity") + 
labs(x = "clarity", y = "revenue") + 
facet_wrap(~ cut) + 
scale_y_continuous(labels = dollar, expand = c(0, 0)) + 
theme(axis.text.x = element_text(angle = 90, hjust = 1), 
    axis.text.y = element_text(colour = "#4B92DB"), 
    legend.position = "bottom") 

p2 <- ggplot(d1, aes(x = clarity, y = stones, colour = "red")) + 
    geom_point(size = 4) + 
    labs(x = "", y = "number of stones") + expand_limits(y = 0) + 
    scale_y_continuous(labels = comma, expand = c(0, 0)) + 
    scale_colour_manual(name = '', values = c("red", "green"),         
    labels =  c("Number of Stones"))+ 
    facet_wrap(~ cut) + 
    theme(axis.text.y = element_text(colour = "red")) + 
    theme(panel.background = element_rect(fill = NA), 
     panel.grid.major = element_blank(), 
     panel.grid.minor = element_blank(), 
     panel.border = element_rect(fill = NA, colour = "grey50"), 
     legend.position = "bottom") 


# Get the ggplot grobs 
xx <- ggplot_build(p1) 
g1 <- ggplot_gtable(xx) 

yy <- ggplot_build(p2) 
g2 <- ggplot_gtable(yy) 

nrow = length(unique(xx$panel$layout$ROW)) 
ncol = length(unique(xx$panel$layout$COL)) 
npanel = length(xx$panel$layout$PANEL) 

pp <- c(subset(g1$layout, grepl("panel", g1$layout$name), se = t:r)) 
g <- gtable_add_grob(g1, g2$grobs[grepl("panel", g1$layout$name)], 
        pp$t, pp$l, pp$b, pp$l) 

hinvert_title_grob <- function(grob){ 
    widths <- grob$widths 
    grob$widths[1] <- widths[3] 
    grob$widths[3] <- widths[1] 
    grob$vp[[1]]$layout$widths[1] <- widths[3] 
    grob$vp[[1]]$layout$widths[3] <- widths[1] 

    grob$children[[1]]$hjust <- 1 - grob$children[[1]]$hjust 
    grob$children[[1]]$vjust <- 1 - grob$children[[1]]$vjust 
    grob$children[[1]]$x <- unit(1, "npc") - grob$children[[1]]$x 
    grob 
} 

j = 1 
k = 0 

for(i in 1:npanel){ 
    if ((i %% ncol == 0) || (i == npanel)){ 
    k = k + 1 
    index <- which(g2$layout$name == "axis_l-1") # Which grob 
    yaxis <- g2$grobs[[index]]     # Extract the grob 
    ticks <- yaxis$children[[2]] 
    ticks$widths <- rev(ticks$widths) 
    ticks$grobs <- rev(ticks$grobs) 
    ticks$grobs[[1]]$x <- ticks$grobs[[1]]$x - unit(1, "npc") 
    ticks$grobs[[2]] <- hinvert_title_grob(ticks$grobs[[2]]) 
    yaxis$children[[2]] <- ticks 
    if (k == 1)#to ensure just once d secondary axisis printed 
     g <- gtable_add_cols(g,g2$widths[g2$layout[index,]$l], 
       max(pp$r[j:i])) 
     g <- gtable_add_grob(g,yaxis,max(pp$t[j:i]),max(pp$r[j:i])+1, 
       max(pp$b[j:i]) 
        , max(pp$r[j:i]) + 1, clip = "off", name = "2ndaxis") 
    j = i + 1 
    } 
} 

# inserts the label for 2nd y-axis 
loc_1st_yaxis_label <- c(subset(g$layout, grepl("ylab", g$layout$name), se 
         = t:r)) 
loc_2nd_yaxis_max_r <- c(subset(g$layout, grepl("2ndaxis", g$layout$name), 
         se = t:r)) 
zz <- max(loc_2nd_yaxis_max_r$r)+1 
loc_1st_yaxis_label$l <- zz 
loc_1st_yaxis_label$r <- zz 

index <- which(g2$layout$name == "ylab") 
ylab <- g2$grobs[[index]]    # Extract that grob 
ylab <- hinvert_title_grob(ylab) 
ylab$children[[1]]$rot <- ylab$children[[1]]$rot + 180 
g <- gtable_add_grob(g, ylab, loc_1st_yaxis_label$t, loc_1st_yaxis_label$l 
        , loc_1st_yaxis_label$b, loc_1st_yaxis_label$r 
        , clip = "off", name = "2ndylab") 
grid.draw(g) 

@Sandy hier ist der Code und its output

nur war Ärger, dass die sekundären y-Achsenbeschriftungen in der letzten Reihe sind innerhalb der panels.I zu lösen versucht, dies aber nicht in der Lage zu

+0

„i realisiert, alles wird, wenn ich, wie verstehen bekommen gelöst manipuliere das Koordinatensystem des Gitters (t, b, l, r) der Grobs. "Ich bezweifle das. Ich musste sie nie für solche Aufgaben bearbeiten. – Roland

+0

@Roland was sollte dann der Ansatz sein? Sir? Ich würde gerne d Grundlagen lernen. Bitte schlagen Sie vor und leiten Sie mich mit den richtigen Schritten –

+0

Sie könnten etwas aus [this] (http://stackoverflow.com/questions/26917689/how-to-use-facets-with -a-Dual-y-Achse-ggplot/37336658 # 37336658) –

Antwort

10

Es gab Probleme mit Ihren gtable_add_cols() und gtable_add_grob() Befehle. Ich habe unten die Kommentare hinzugefügt.

zu ggplot2 v2.2.0

library(ggplot2) 
library(gtable) 
library(grid) 
library(data.table) 
library(scales) 

diamonds$cut <- sample(letters[1:4], nrow(diamonds), replace = TRUE) 
dt.diamonds <- as.data.table(diamonds) 
d1 <- dt.diamonds[,list(revenue = sum(price), 
         stones = length(price)), 
        by=c("clarity", "cut")] 
setkey(d1, clarity, cut) 

# The facet_wrap plots 
p1 <- ggplot(d1, aes(x = clarity, y = revenue, fill = cut)) + 
    geom_bar(stat = "identity") + 
    labs(x = "clarity", y = "revenue") + 
    facet_wrap(~ cut, nrow = 2) + 
    scale_y_continuous(labels = dollar, expand = c(0, 0)) + 
    theme(axis.text.x = element_text(angle = 90, hjust = 1), 
     axis.text.y = element_text(colour = "#4B92DB"), 
     legend.position = "bottom") 

p2 <- ggplot(d1, aes(x = clarity, y = stones, colour = "red")) + 
    geom_point(size = 4) + 
    labs(x = "", y = "number of stones") + expand_limits(y = 0) + 
    scale_y_continuous(labels = comma, expand = c(0, 0)) + 
    scale_colour_manual(name = '', values = c("red", "green"), 
     labels =c("Number of Stones")) + 
    facet_wrap(~ cut, nrow = 2) + 
    theme(axis.text.y = element_text(colour = "red")) + 
    theme(panel.background = element_rect(fill = NA), 
     panel.grid.major = element_blank(), 
     panel.grid.minor = element_blank(), 
     panel.border = element_rect(fill = NA, colour = "grey50"), 
     legend.position = "bottom") 



# Get the ggplot grobs 
g1 <- ggplotGrob(p1) 
g2 <- ggplotGrob(p2) 


# Grab the panels from g2 and overlay them onto the panels of g1 
pp <- c(subset(g1$layout, grepl("panel", g1$layout$name), select = t:r)) 
g <- gtable_add_grob(g1, g2$grobs[grepl("panel", g1$layout$name)], 
        pp$t, pp$l, pp$b, pp$l) 


# Function to invert labels 
hinvert_title_grob <- function(grob){ 
widths <- grob$widths 
grob$widths[1] <- widths[3] 
grob$widths[3] <- widths[1] 
grob$vp[[1]]$layout$widths[1] <- widths[3] 
grob$vp[[1]]$layout$widths[3] <- widths[1] 

grob$children[[1]]$hjust <- 1 - grob$children[[1]]$hjust 
grob$children[[1]]$vjust <- 1 - grob$children[[1]]$vjust 
grob$children[[1]]$x <- unit(1, "npc") - grob$children[[1]]$x 
grob 
} 

# Get the y label from g2, and invert it 
index <- which(g2$layout$name == "ylab-l") 
ylab <- g2$grobs[[index]]    # Extract that grob 
ylab <- hinvert_title_grob(ylab) 


# Put the y label into g, to the right of the right-most panel 
# Note: Only one column and one y label 
g <- gtable_add_cols(g, g2$widths[g2$layout[index, ]$l], pos = max(pp$r)) 

g <-gtable_add_grob(g,ylab, t = min(pp$t), l = max(pp$r)+1, 
          b = max(pp$b), r = max(pp$r)+1, 
        clip = "off", name = "ylab-r") 


# Get the y axis from g2, reverse the tick marks and the tick mark labels, 
# and invert the tick mark labels 
index <- which(g2$layout$name == "axis-l-1-1") # Which grob 
yaxis <- g2$grobs[[index]]     # Extract the grob 

ticks <- yaxis$children[[2]] 
ticks$widths <- rev(ticks$widths) 
ticks$grobs <- rev(ticks$grobs) 

plot_theme <- function(p) { 
    plyr::defaults(p$theme, theme_get()) 
} 

tml <- plot_theme(p1)$axis.ticks.length # Tick mark length 
ticks$grobs[[1]]$x <- ticks$grobs[[1]]$x - unit(1, "npc") + tml 

ticks$grobs[[2]] <- hinvert_title_grob(ticks$grobs[[2]]) 
yaxis$children[[2]] <- ticks 


# Put the y axis into g, to the right of the right-most panel 
# Note: Only one column, but two y axes - one for each row of the facet_wrap plot 
g <- gtable_add_cols(g, g2$widths[g2$layout[index, ]$l], pos = max(pp$r)) 

nrows = length(unique(pp$t)) # Number of rows 
g <- gtable_add_grob(g, rep(list(yaxis), nrows), 
       t = unique(pp$t), l = max(pp$r)+1, 
       b = unique(pp$b), r = max(pp$r)+1, 
       clip = "off", name = paste0("axis-r-", 1:nrows)) 



# Get the legends 
leg1 <- g1$grobs[[which(g1$layout$name == "guide-box")]] 
leg2 <- g2$grobs[[which(g2$layout$name == "guide-box")]] 

# Combine the legends 
g$grobs[[which(g$layout$name == "guide-box")]] <- 
    gtable:::cbind_gtable(leg1, leg2, "first") 

grid.newpage() 
grid.draw(g) 

enter image description here


SO ist kein Tutorial-Website, aktualisiert und dies könnte den Zorn anderer SO Benutzer entstehen, aber es gibt zu viel für einen Kommentar.

Zeichnen Sie ein Diagramm mit einem Plot Panel nur (das heißt, keine Facettierung),

library(ggplot2) 

p <- ggplot(mtcars, aes(x = mpg, y = disp)) + geom_point() 

die ggplot grob Holen.

g <- ggplotGrob(p) 

Entdecken Sie die Handlung grob:
1) gtable_show_layout() geben ein Diagramm des gtable Layout Komplott. Der große Raum in der Mitte ist der Ort des Plot-Panels. Spalten links neben und unter dem Panel enthalten die y- und x-Achsen. Und es gibt einen Rand, der das ganze Grundstück umgibt. Die Indizes geben den Ort jeder Zelle im Array an. Beachten Sie, dass sich das Panel beispielsweise in der dritten Zeile der vierten Spalte befindet.

gtable_show_layout(g) 

2) Der Layoutdatenrahmen. g$layout gibt ein Datenframe zurück, das die Namen der in der Zeichnung enthaltenen Grobs zusammen mit ihren Positionen innerhalb der gtable enthält: t, l, b und r (steht für oben, links, rechts und unten). Beachten Sie zum Beispiel, dass sich das Panel bei t = 3, l = 4, b = 3, r = 4 befindet. Dies ist derselbe Plattenplatz, der oben aus dem Diagramm erhalten wurde.

g$layout 

3) Das Diagramm des Layouts versucht, die Höhen und Breiten der Reihen und Spalten zu geben, aber sie neigen dazu, zu überlappen. Verwenden Sie stattdessen g$widths und g$heights. Die 1-Zoll-Breite und Höhe ist die Breite und Höhe des Plotpanels. Beachten Sie, dass 1null die 3. Höhe und die 4. Breite - 3 und 4 wieder ist.

Zeichnen Sie nun ein facet_wrap und ein facet_grid-Diagramm.

p1 <- ggplot(mtcars, aes(x = mpg, y = disp)) + geom_point() + 
    facet_wrap(~ carb, nrow = 1) 

p2 <- ggplot(mtcars, aes(x = mpg, y = disp)) + geom_point() + 
    facet_grid(. ~ carb) 

g1 <- ggplotGrob(p1) 
g2 <- ggplotGrob(p2) 

Die zwei Plots sehen gleich aus, aber ihre Tabellen unterscheiden sich. Auch die Namen der Komponenten-Grobs unterscheiden sich.

Oft ist es praktisch, eine Teilmenge des Layout-Datenrahmens zu erhalten, die die Indizes (d. H. T, l, b und r) von Grobs eines gemeinsamen Typs enthält; sage alle Panels.

pp1 <- subset(g1$layout, grepl("panel", g1$layout$name), select = t:r) 
pp2 <- subset(g2$layout, grepl("panel", g2$layout$name), select = t:r) 

Hinweis beispielsweise, dass alle Platten sind in der Zeile 4 (pp1$t, pp2$t).
pp1$r bezieht sich auf die Spalten, die die Diagrammfelder enthalten;
pp1$r + 1 bezieht sich auf die Spalten auf der rechten Seite der Panels;
max(pp1$r) bezieht sich auf die rechte Spalte, die ein Panel enthält;
max(pp1$r) + 1 bezieht sich auf die Spalte rechts von der rechten Spalte, die ein Panel enthält;
und so weiter.

Zeichnen Sie schließlich ein facet_wrap-Diagramm mit mehr als einer Zeile.

Erkunden Sie das Diagramm wie zuvor, aber auch den Layout-Datenrahmen, der die Indizes der Panels enthält.

pp3 <- subset(g3$layout, grepl("panel", g3$layout$name), select = t:r) 

Wie man erwarten würde, pp3 sagen Ihnen, dass die Handlung Platten in drei Spalten angeordnet sind (4, 7 und 10) und zwei Reihen (4 und 8).

Diese Indizes werden verwendet, wenn Zeilen oder Spalten zur Tabelle g hinzugefügt werden und wenn grobs zu einer Tabelle g hinzugefügt wird. Überprüfen Sie diese Befehle mit ?gtable_add_rows und gtable_add_grob.

Außerdem lernen einige grid, vor allem, wie Grobs, und die Verwendung von Einheiten zu konstruieren (einige Ressourcen im r-grid Tag gegeben werden hier auf SO.

+0

Vielen Dank dafür ... Sie haben d Richtung Sir gegeben –

+0

Ich habe meine Ausgabe als meine Antwort unten veröffentlicht. Würden Sie mir helfen, die Lücke zwischen den Etiketten der sekundären Achsen und den Markierungen der Teilstriche zu verkleinern? –

+0

gibt es eine Möglichkeit, die Gtable ::: Cbind_gtable() zu ersetzen, um die 2 Gtables Legenden zu kombinieren? weil auf der Hilfeseite? ':::' bevorzugen sie nicht den Triple-Doppelpunkt-Operator zu verwenden. –