Наложение двух графиков друг на друга

Question

Я работаю с двумя графиками.

Участок 1 : Стебель и лист

data("mtcars")
x <- mtcars$wt
stem(x)


 1 | 5689
 2 | 123
 2 | 56889
 3 | 22224444
 3 | 55667888
 4 | 1
 4 | 
 5 | 334

Участок 2 : значения Z для эти точки данных

 mu = mean(x)
 sdev <- sd(x)

 y <- (1/(sdev * sqrt(2*pi))) * exp(-((x-mu)^2)/(2*sdev^2))
 plot(x,y, pch = 8)

My goal is to overlay these two plots on top of each other. The expected plot would look something like this. Any suggestions or help is much appreciated. Thanks. введите описание изображения здесь

Answer 1

К сожалению, функция stem ничего не возвращает, что усложняет жизнь. Плюс код написан в C, который доступен здесь . Я попытался воспроизвести функцию stem с помощью простых функций R, и это определенно не соответствует коду C, но работает для этого образца набора данных. Я определенно не использовал аргументы основы (масштаб, ширина, атом).

data(mtcars)

x <- mtcars$wt
stem(x) # you can see the result from the question.

mu = mean(x)
sdev <- sd(x)

y <- (1/(sdev * sqrt(2*pi))) * exp(-((x-mu)^2)/(2*sdev^2))

Это ваш график плотности:

par(mar=c(2,1,1,1))
plot(x, y, pch = 8, xaxt="n", yaxt="n", ylab="", col="grey)

Теперь нам нужно заново изобрести stem функционировать с нуля. Сначала я использую функцию hist для определения «лучших» точек останова, что, как я предполагаю, похоже на то, что делает stem.

h <- hist(round(x,1), right=FALSE, plot=F)
bin <- h$breaks; bin
#[1] 1.5 2.0 2.5 3.0 3.5 4.0 4.5 5.0 5.5

Затем я использую вырезать до назначьте значения x в правильные ячейки.

xgr <- sort(cut(round(x,1), breaks = bin, right=FALSE, labels = FALSE, include = TRUE))

Затем я использую функцию rowid из data.table , чтобы определить значения оси Y, разделив их длину, чтобы получить плотности так, чтобы два графика использовали одну и ту же систему оси Y.

library(data.table)
y <- rowid(xgr)/length(xgr); y

Фактические символы для построения (pch) берутся из первого di git после десятичного разряда.

pch <- as.character(round(10*(round(sort(x),1) %% 1))); pch
# [1] "5" "6" "8" "9" "1" "2" "3" "5" "6" "8" "8" "9" "1" "2" "2" "2"
#[17] "4" "4" "4" "4" "5" "5" "6" "6" "7" "8" "8" "8" "1" "2" "3" "4"

И, наконец, «at» для оси x.

at <- seq(min(x), max(x), length.out=length(bin)-1)
x <- rep(at, h$counts)
    
points(x, y, pch = pch, col="red")
axis(side=1, at=at, labels=trunc(bin[-length(bin)]), tck=-0.02, mgp=c(1,0.3,0), col="red", col.axis="red")

A notable difference is that stem doesn't use round as I've done here. It appears to use floor(x+0.5) at lines 96 and 103, which explains the slight differences. Another problem is that it will need tweaking to be more robust.

For example, replacing x with mtcars$drat would need changing the scale argument to 0.5.

x 

введите описание изображения здесь

Answer 2

stem() на самом деле не создает типичного графического графика (при этом я не могу сохранить или легко извлечь информацию из его структуры), поэтому я не уверен, как вы можете наложить вывод stem() на графический график, например те, которые создаются plot() или ggplot().

Однако, одна из альтернатив для получения информации о двух графиках на одном графике - использовать ggplot() с annotate(), чтобы показать информацию stem() графика 1 и geom_point(), чтобы показать диаграмму рассеяния на графике 2.

stem(x) # copy and paste this stem-and-leaf plot to a variable
sal <- c("1 | 5689", "2 | 123", "2 | 56889", "3 | 22224444", "3 | 55667888", "4 | 1", "4 | ", "5 | 334")

# make sal into a single string, collapse using new lines ("\n")
sal2 <- paste(sal, collapse="\n\n") # here I am using two new lines to widen the line spacing
sal2 <- gsub("\\|" ," ", sal2) # change the vertical bar ("|") to a space if you want to later replace it with geom_segment() (optional depending on how you like your aesthetics)

sal_x_position <- min(x) + (max(x) - min(x))/2 # the center of x-axis will be the center of the stem-and-leaf
    
df <- data.frame(x, y)

ggplot(df, aes(x, y)) + 
  # plot Plot 1
  annotate("text", x = sal_x_position, y = 0, label = sal2, angle = 90, hjust = 0, col = "red") + 
  geom_segment(aes(x = 2, y = 0.015, xend = 5, yend = 0.015), col = "red") + # add a line between the stems and leaves (caveat: must choose custom coordinates for its location)
  # plot Plot 2
  geom_point(pch = 8) + 
  geom_line() + 
  # customize other plot aesthetics
  theme_bw() + 
  theme(panel.grid = element_blank())

Наложенный график стеблей и листьев с диаграммой рассеяния

Обратите внимание, что вы также можете использовать sal вместо sal2, если хотите больше контролировать, где каждый текст отображается на графике. Вам просто нужно будет использовать несколько слоев annotate() и указать каждое местоположение ( см. Мой исходный пост в истории редактирования для примера ).