Scatterplot ที่มีฮิสโตแกรมส่วนเพิ่มใน ggplot2

มีวิธีการสร้างแผนการกระจายที่มีฮิสโตแกรมเล็กน้อยเหมือนในตัวอย่างด้านล่างggplot2หรือไม่? ใน Matlab มันเป็นscatterhist()ฟังก์ชั่นและมีอยู่เทียบเท่ากับ R เช่นกัน อย่างไรก็ตามฉันไม่เห็น ggplot2

ฉันเริ่มต้นความพยายามด้วยการสร้างกราฟเดี่ยว แต่ไม่ทราบวิธีจัดเรียงอย่างถูกต้อง

 require(ggplot2)
 x<-rnorm(300)
 y<-rt(300,df=2)
 xy<-data.frame(x,y)
     xhist <- qplot(x, geom="histogram") + scale_x_continuous(limits=c(min(x),max(x))) + opts(axis.text.x = theme_blank(), axis.title.x=theme_blank(), axis.ticks = theme_blank(), aspect.ratio = 5/16, axis.text.y = theme_blank(), axis.title.y=theme_blank(), background.colour="white")
     yhist <- qplot(y, geom="histogram") + coord_flip() + opts(background.fill = "white", background.color ="black")

     yhist <- yhist + scale_x_continuous(limits=c(min(x),max(x))) + opts(axis.text.x = theme_blank(), axis.title.x=theme_blank(), axis.ticks = theme_blank(), aspect.ratio = 16/5, axis.text.y = theme_blank(), axis.title.y=theme_blank() )


     scatter <- qplot(x,y, data=xy)  + scale_x_continuous(limits=c(min(x),max(x))) + scale_y_continuous(limits=c(min(y),max(y)))
none <- qplot(x,y, data=xy) + geom_blank()

และการจัดเรียงพวกเขาด้วยฟังก์ชั่นที่โพสต์ที่นี่ แต่เพื่อทำให้เรื่องสั้นสั้น: มีวิธีสร้างกราฟเหล่านี้หรือไม่?

gridExtraแพคเกจควรจะทำงานที่นี่ เริ่มต้นด้วยการทำให้วัตถุ ggplot แต่ละรายการ:

hist_top <- ggplot()+geom_histogram(aes(rnorm(100)))
empty <- ggplot()+geom_point(aes(1,1), colour="white")+
         theme(axis.ticks=element_blank(), 
               panel.background=element_blank(), 
               axis.text.x=element_blank(), axis.text.y=element_blank(),           
               axis.title.x=element_blank(), axis.title.y=element_blank())

scatter <- ggplot()+geom_point(aes(rnorm(100), rnorm(100)))
hist_right <- ggplot()+geom_histogram(aes(rnorm(100)))+coord_flip()

จากนั้นใช้ฟังก์ชัน grid.arrange:

grid.arrange(hist_top, empty, scatter, hist_right, ncol=2, nrow=2, widths=c(4, 1), heights=c(1, 4))

นี่ไม่ใช่คำตอบที่สมบูรณ์ แต่มันง่ายมาก มันแสดงให้เห็นถึงวิธีการอื่นเพื่อแสดงความหนาแน่นของขอบและวิธีการใช้ระดับอัลฟาสำหรับเอาต์พุตกราฟิกที่รองรับความโปร่งใส:

scatter <- qplot(x,y, data=xy)  + 
         scale_x_continuous(limits=c(min(x),max(x))) + 
         scale_y_continuous(limits=c(min(y),max(y))) + 
         geom_rug(col=rgb(.5,0,0,alpha=.2))
scatter

อาจจะช้าไปหน่อย แต่ฉันตัดสินใจทำแพ็คเกจ ( ggExtra) เพราะมันเกี่ยวข้องกับโค้ดนิดหน่อยและน่าเบื่อที่จะเขียน แพคเกจยังพยายามที่จะแก้ไขปัญหาที่พบบ่อยบางอย่างเช่นสร้างความมั่นใจว่าแม้ว่าจะมีชื่อเรื่องหรือข้อความมีขนาดใหญ่ขึ้นแผนการจะยังคงอยู่ในแนวเดียวกัน

แนวคิดพื้นฐานคล้ายกับคำตอบที่ให้ไว้ที่นี่ แต่มันไปไกลกว่านั้น นี่คือตัวอย่างของวิธีการเพิ่มฮิสโตแกรมส่วนเพิ่มให้กับชุดสุ่ม 1,000 คะแนน หวังว่านี่จะช่วยให้ง่ายขึ้นในการเพิ่มฮิสโตแกรม / ความหนาแน่นในอนาคต

ลิงก์ไปยังแพ็คเกจ ggExtra

library(ggplot2)
df <- data.frame(x = rnorm(1000, 50, 10), y = rnorm(1000, 50, 10))
p <- ggplot(df, aes(x, y)) + geom_point() + theme_classic()
ggExtra::ggMarginal(p, type = "histogram")

นอกจากนี้เพื่อประหยัดเวลาในการค้นหาผู้ที่ทำสิ่งนี้หลังจากเรา

ตำนานฉลากแกนข้อความแกนเห็บทำให้พล็อตลอยไปจากกันดังนั้นพล็อตของคุณจะดูน่าเกลียดและไม่สอดคล้องกัน

คุณสามารถแก้ไขได้โดยใช้การตั้งค่าธีมเหล่านี้

+theme(legend.position = "none",          
       axis.title.x = element_blank(),
       axis.title.y = element_blank(),
       axis.text.x = element_blank(),
       axis.text.y = element_blank(), 
       plot.margin = unit(c(3,-5.5,4,3), "mm"))

และจัดระดับเครื่องชั่ง

+scale_x_continuous(breaks = 0:6,
                    limits = c(0,6),
                    expand = c(.05,.05))

ดังนั้นผลลัพธ์จะดูตกลง:

เพียงเล็กน้อยในคำตอบของ BondedDustในจิตวิญญาณทั่วไปของตัวชี้วัดการกระจายตัว

Edward Tufteเรียกการใช้พรมผืนนี้ว่า 'dot-dash plot' และมีตัวอย่างใน VDQI ของการใช้เส้นแกนเพื่อระบุช่วงของตัวแปรแต่ละตัว ในตัวอย่างของฉันฉลากแกนและเส้นกริดยังแสดงการกระจายของข้อมูล ฉลากจะอยู่ที่ค่าของการสรุปหมายเลขห้าของ Tukey (ขั้นต่ำ, บานพับล่าง, ค่ามัธยฐาน, บานพับด้านบน, สูงสุด) ให้ความประทับใจอย่างรวดเร็วเกี่ยวกับการแพร่กระจายของตัวแปรแต่ละตัว

ตัวเลขห้าตัวนี้จึงเป็นตัวแทนตัวเลขของ boxplot มันค่อนข้างยุ่งยากเพราะเส้นกริดที่เว้นระยะไม่เท่ากันแนะนำว่าแกนมีสเกลที่ไม่ใช่เชิงเส้น (ในตัวอย่างนี้พวกมันเป็นเส้นตรง) อาจเป็นการดีที่สุดที่จะละเว้นเส้นกริดหรือบังคับให้อยู่ในตำแหน่งปกติและให้ป้ายแสดงข้อมูลสรุปหมายเลขห้า

x<-rnorm(300)
y<-rt(300,df=10)
xy<-data.frame(x,y)

require(ggplot2); require(grid)
# make the basic plot object
ggplot(xy, aes(x, y)) +        
  # set the locations of the x-axis labels as Tukey's five numbers   
  scale_x_continuous(limit=c(min(x), max(x)), 
                     breaks=round(fivenum(x),1)) +     
  # ditto for y-axis labels 
  scale_y_continuous(limit=c(min(y), max(y)),
                     breaks=round(fivenum(y),1)) +     
  # specify points
  geom_point() +
  # specify that we want the rug plot
  geom_rug(size=0.1) +   
  # improve the data/ink ratio
  theme_set(theme_minimal(base_size = 18))

เนื่องจากไม่มีวิธีแก้ปัญหาที่น่าพอใจสำหรับพล็อตประเภทนี้เมื่อเปรียบเทียบกลุ่มต่าง ๆ ฉันจึงเขียน ฟังก์ชันเพื่อทำสิ่งนี้

มันทำงานได้ทั้งข้อมูลที่จัดกลุ่มและไม่ได้จัดกลุ่มและยอมรับพารามิเตอร์กราฟิกเพิ่มเติม:

marginal_plot(x = iris$Sepal.Width, y = iris$Sepal.Length)

marginal_plot(x = Sepal.Width, y = Sepal.Length, group = Species, data = iris, bw = "nrd", lm_formula = NULL, xlab = "Sepal width", ylab = "Sepal length", pch = 15, cex = 0.5)

ฉันพบแพ็คเกจแล้ว (ggpubr ) ที่ทำงานได้ดีมากสำหรับปัญหานี้และพิจารณาความเป็นไปได้หลายประการในการแสดงข้อมูล

ลิงค์ไปยังแพ็คเกจอยู่ที่นี่และในลิงค์นี้คุณจะพบกับบทแนะนำที่ดีในการใช้งาน เพื่อความสมบูรณ์ฉันแนบหนึ่งในตัวอย่างที่ฉันทำซ้ำ

ฉันติดตั้งแพคเกจแรก (จำเป็นต้องมีdevtools)

if(!require(devtools)) install.packages("devtools")
devtools::install_github("kassambara/ggpubr")

สำหรับตัวอย่างที่แสดงฮิสโทแกรมที่แตกต่างกันสำหรับกลุ่มต่าง ๆ มันกล่าวถึงggExtra: "ข้อ จำกัด อย่างหนึ่งggExtraคือมันไม่สามารถรับมือกับหลายกลุ่มในพล็อตกระจายและพล็อตส่วนในรหัส R ด้านล่างเราให้ โซลูชันที่ใช้cowplotแพ็คเกจ " ในกรณีของฉันฉันต้องติดตั้งแพ็คเกจหลัง:

install.packages("cowplot")

และฉันได้ติดตามรหัสชิ้นนี้:

# Scatter plot colored by groups ("Species")
sp <- ggscatter(iris, x = "Sepal.Length", y = "Sepal.Width",
            color = "Species", palette = "jco",
            size = 3, alpha = 0.6)+
border()                                         
# Marginal density plot of x (top panel) and y (right panel)
xplot <- ggdensity(iris, "Sepal.Length", fill = "Species",
               palette = "jco")
yplot <- ggdensity(iris, "Sepal.Width", fill = "Species", 
               palette = "jco")+
rotate()
# Cleaning the plots
sp <- sp + rremove("legend")
yplot <- yplot + clean_theme() + rremove("legend") 
xplot <- xplot + clean_theme() + rremove("legend")
# Arranging the plot using cowplot
library(cowplot)
plot_grid(xplot, NULL, sp, yplot, ncol = 2, align = "hv", 
      rel_widths = c(2, 1), rel_heights = c(1, 2))

ซึ่งทำงานได้ดีสำหรับฉัน:

ไอริสตั้งกราฟฮิสโทแกรมแบบกระจาย

คุณสามารถสร้าง scatterplots ที่น่าสนใจด้วยฮิสโตแกรม marginal โดยใช้ggstatsplot (มันจะพอดีและอธิบายโมเดล):

data(iris)

library(ggstatsplot)

ggscatterstats(
  data = iris,                                          
  x = Sepal.Length,                                                  
  y = Sepal.Width,
  xlab = "Sepal Length",
  ylab = "Sepal Width",
  marginal = TRUE,
  marginal.type = "histogram",
  centrality.para = "mean",
  margins = "both",
  title = "Relationship between Sepal Length and Sepal Width",
  messages = FALSE
)

หรือน่าสนใจกว่าเล็กน้อย (โดยค่าเริ่มต้น) ggpubr :

devtools::install_github("kassambara/ggpubr")
library(ggpubr)

ggscatterhist(
  iris, x = "Sepal.Length", y = "Sepal.Width",
  color = "Species", # comment out this and last line to remove the split by species
  margin.plot = "histogram", # I'd suggest removing this line to get density plots
  margin.params = list(fill = "Species", color = "black", size = 0.2)
)

UPDATE:

ตามที่แนะนำโดย @ aickley ฉันใช้เวอร์ชันที่พัฒนาขึ้นเพื่อสร้างพล็อต

นี่เป็นคำถามเก่า แต่ฉันคิดว่ามันจะมีประโยชน์ในการโพสต์การอัปเดตที่นี่เนื่องจากฉันได้พบปัญหาเดียวกันนี้เมื่อเร็ว ๆ นี้ (ขอบคุณ Stefanie Mueller สำหรับความช่วยเหลือ!)

คำตอบที่ได้รับการโหวตมากที่สุดโดยใช้งาน gridExtra แต่การจัดเรียงแกนนั้นยาก / แฮ็คอย่างที่ได้กล่าวไว้ในความคิดเห็น สามารถแก้ไขได้โดยใช้คำสั่ง ggMarginal จากแพ็คเกจ ggExtra ดังเช่น:

#load packages
library(tidyverse) #for creating dummy dataset only
library(ggExtra)

#create dummy data
a = round(rnorm(1000,mean=10,sd=6),digits=0)
b = runif(1000,min=1.0,max=1.6)*a
b = b+runif(1000,min=9,max=15)

DummyData <- data.frame(var1 = b, var2 = a) %>% 
  filter(var1 > 0 & var2 > 0)

#plot
p = ggplot(DummyData, aes(var1, var2)) + geom_point(alpha=0.3)
ggMarginal(p, type = "histogram")

ฉันลองใช้ตัวเลือกเหล่านั้น แต่ไม่พอใจกับผลลัพธ์หรือโค้ดยุ่ง ๆ ที่จะต้องใช้เพื่อไปที่นั่น โชคดีที่ฉัน Thomas Lin Pedersen เพิ่งพัฒนาแพ็คเกจที่เรียกว่าเย็บปะติดปะต่อกันซึ่งทำให้งานเสร็จอย่างสวยงาม

หากคุณต้องการสร้างแผนการกระจายที่มีฮิสโตแกรมส่วนเพิ่มก่อนอื่นคุณต้องสร้างสามแปลงแยกกัน

library(ggplot2)

x <- rnorm(300)
y <- rt(300, df = 2)
xy <- data.frame(x, y)

plot1 <- ggplot(xy, aes(x = x, y = y)) + 
  geom_point() 

dens1 <- ggplot(xy, aes(x = x)) + 
  geom_histogram(color = "black", fill = "white") + 
  theme_void()

dens2 <- ggplot(xy, aes(x = y)) + 
  geom_histogram(color = "black", fill = "white") + 
  theme_void() + 
  coord_flip()

สิ่งเดียวที่ต้องทำคือการเพิ่มแปลงเหล่านั้นด้วยวิธีง่าย ๆ+และระบุเค้าโครงด้วยฟังก์ชันplot_layout()และระบุรูปแบบที่มีฟังก์ชั่น

library(patchwork)

dens1 + plot_spacer() + plot1 + dens2 + 
  plot_layout(
    ncol = 2, 
    nrow = 2, 
    widths = c(4, 1),
    heights = c(1, 4)
  ) 

ฟังก์ชั่นplot_spacer()เพิ่มพล็อตที่ว่างเปล่าที่มุมขวาบน ข้อโต้แย้งอื่น ๆ ทั้งหมดควรอธิบายด้วยตนเอง

เนื่องจากฮิสโทแกรมนั้นขึ้นอยู่กับความกว้างของแบนด์วิดธ์ที่เลือกจึงอาจต้องการความหนาแน่นมากขึ้น ด้วยการดัดแปลงเล็ก ๆ น้อย ๆ ใครจะได้รับเช่นสำหรับข้อมูลการติดตามสายตาพล็อตที่สวยงาม

library(ggpubr)

plot1 <- ggplot(df, aes(x = Density, y = Face_sum, color = Group)) + 
  geom_point(aes(color = Group), size = 3) + 
  geom_point(shape = 1, color = "black", size = 3) + 
  stat_smooth(method = "lm", fullrange = TRUE) +
  geom_rug() + 
  scale_y_continuous(name = "Number of fixated faces", 
                     limits = c(0, 205), expand = c(0, 0)) + 
  scale_x_continuous(name = "Population density (lg10)", 
                     limits = c(1, 4), expand = c(0, 0)) + 
  theme_pubr() +
  theme(legend.position = c(0.15, 0.9)) 

dens1 <- ggplot(df, aes(x = Density, fill = Group)) + 
  geom_density(alpha = 0.4) + 
  theme_void() + 
  theme(legend.position = "none")

dens2 <- ggplot(df, aes(x = Face_sum, fill = Group)) + 
  geom_density(alpha = 0.4) + 
  theme_void() + 
  theme(legend.position = "none") + 
  coord_flip()

dens1 + plot_spacer() + plot1 + dens2 + 
  plot_layout(ncol = 2, nrow = 2, widths = c(4, 1), heights = c(1, 4))

แม้ว่าข้อมูลจะไม่ได้รับในจุดนี้หลักการพื้นฐานควรมีความชัดเจน

หากต้องการสร้างคำตอบโดย @ alf-pascu ให้ตั้งค่าแต่ละแผนด้วยตนเองและจัดเรียงด้วย cowplotความยืดหยุ่นอย่างมากทั้งในส่วนหลักและส่วนล่าง (เทียบกับโซลูชันอื่น ๆ ) การแจกแจงตามกลุ่มเป็นตัวอย่างหนึ่ง การเปลี่ยนพล็อตหลักเป็นพล็อตความหนาแน่น 2D เป็นอีกเรื่องหนึ่ง

ต่อไปนี้สร้าง scatterplot ที่มีฮิสโตแกรม (จัดตำแหน่งอย่างเหมาะสม)

library("ggplot2")
library("cowplot")

# Set up scatterplot
scatterplot <- ggplot(iris, aes(x = Sepal.Length, y = Sepal.Width, color = Species)) +
  geom_point(size = 3, alpha = 0.6) +
  guides(color = FALSE) +
  theme(plot.margin = margin())


# Define marginal histogram
marginal_distribution <- function(x, var, group) {
  ggplot(x, aes_string(x = var, fill = group)) +
    geom_histogram(bins = 30, alpha = 0.4, position = "identity") +
    # geom_density(alpha = 0.4, size = 0.1) +
    guides(fill = FALSE) +
    theme_void() +
    theme(plot.margin = margin())
}

# Set up marginal histograms
x_hist <- marginal_distribution(iris, "Sepal.Length", "Species")
y_hist <- marginal_distribution(iris, "Sepal.Width", "Species") +
  coord_flip()

# Align histograms with scatterplot
aligned_x_hist <- align_plots(x_hist, scatterplot, align = "v")[[1]]
aligned_y_hist <- align_plots(y_hist, scatterplot, align = "h")[[1]]

# Arrange plots
plot_grid(
  aligned_x_hist
  , NULL
  , scatterplot
  , aligned_y_hist
  , ncol = 2
  , nrow = 2
  , rel_heights = c(0.2, 1)
  , rel_widths = c(1, 0.2)
)

หากต้องการลงจุดพล็อตความหนาแน่นแบบ 2 มิติแทนเพียงเปลี่ยนพล็อตหลัก

# Set up 2D-density plot
contour_plot <- ggplot(iris, aes(x = Sepal.Length, y = Sepal.Width, color = Species)) +
  stat_density_2d(aes(alpha = ..piece..)) +
  guides(color = FALSE, alpha = FALSE) +
  theme(plot.margin = margin())

# Arrange plots
plot_grid(
  aligned_x_hist
  , NULL
  , contour_plot
  , aligned_y_hist
  , ncol = 2
  , nrow = 2
  , rel_heights = c(0.2, 1)
  , rel_widths = c(1, 0.2)
)

โซลูชันอื่นที่ใช้ggpubrและcowplotแต่ที่นี่เราสร้างแปลงโดยใช้cowplot::axis_canvasและเพิ่มลงในพล็อตดั้งเดิมด้วยcowplot::insert_xaxis_grob:

library(cowplot) 
library(ggpubr)

# Create main plot
plot_main <- ggplot(faithful, aes(eruptions, waiting)) +
  geom_point()

# Create marginal plots
# Use geom_density/histogram for whatever you plotted on x/y axis 
plot_x <- axis_canvas(plot_main, axis = "x") +
  geom_density(aes(eruptions), faithful)
plot_y <- axis_canvas(plot_main, axis = "y", coord_flip = TRUE) +
  geom_density(aes(waiting), faithful) +
  coord_flip()

# Combine all plots into one
plot_final <- insert_xaxis_grob(plot_main, plot_x, position = "top")
plot_final <- insert_yaxis_grob(plot_final, plot_y, position = "right")
ggdraw(plot_final)

ทุกวันนี้มีแพ็คเกจ CRAN อย่างน้อยหนึ่งแพ็คเกจที่ทำให้สแกตเตอร์แปลงมีฮิสโตแกรมขอบ

library(psych)
scatterHist(rnorm(1000), runif(1000))

คุณสามารถใช้รูปแบบอินเทอร์แอคทีฟggExtra::ggMarginalGadget(yourplot) และเลือกระหว่างบ็อกซ์พล็อตพล็อตไวโอลินพล็อตความหนาแน่นและฮิสโทแกรมได้ง่ายขึ้น

เช่นนั้น