R базовый участок, объедините зеркально отраженные прямоугольные - PullRequest
Новая
       37

R базовый участок, объедините зеркально отраженные прямоугольные

1 голос
/ 23 апреля 2020

Я пытаюсь построить фигуры, состоящие из двух прямоугольных треугольников, расположенных в зеркальном отображении друг друга. Окончательные графики будут иметь уникальный набор данных, но сейчас я строю те же данные. Я более знаком с (возможно, испорченным) ggplot, но я обнаружил, что намного проще сместить положения осей в базе R. Если кто-нибудь знает, как воспроизвести эти прямоугольные графики в ggplot, я бы взял этот ответ!

У меня проблемы с настройкой расстояния и макета. Я не так хорошо знаком с построением базового R, извините, если это что-то вроде basi c.

enter image description here

В частности, я бы хотел:

  • переместите треугольники ближе друг к другу

  • сделайте так, чтобы метки были видны (и используйте верхнюю метку, которая не **main**)

  • сделать диагональную линию flu sh с осями

  • сделать "ножки" из треугольников равной длины 

    library(cowplot)
my.data <- data.frame( my.x = c(.2,.4,.6, .1), my.y = c(.3, .5, .7, .9) )

   top.triangle <- function(){
  plot( my.y ~ my.x, data =  my.data, 
axes = FALSE, ylab = 'Position.2', xlab = NA, main='Position.1',
xlim=c(0,1), ylim=c(0,1),  xaxt="n", yaxt="n" )
  axis(side = 2, las = 1, pos=0)
  axis(side = 3, las = 1, pos=1)
  abline(coef = c(0,1))
   }

bottom.triangle <- function() {
  plot( my.x ~ my.y, data = my.data , 
    axes = FALSE, xlab = 'Position.2', ylab = 'Position.1', xlim=c(0,1), ylim=c(0,1),  xaxt="n", yaxt="n" )
  axis(side = 1, las = 1, pos=0)
  axis(4, las = 1, pos=1) #flip label to right side
  abline(coef = c(0,1))}

plot_grid(top.triangle, bottom.triangle, rel_widths = c(.5,.5))

Спасибо!

1 Ответ

1 голос
/ 23 апреля 2020

Как подсказал @ GregorThomas , вероятно, лучше нарисовать один график. Для этого необходим transform ed дополнительный фрейм данных, который сдвигает значения на расстояние x.dist. 

my.data <- data.frame(my.x=c(.2, .4, .6, .1), my.y=c(.3, .5, .7, .9))
x.dist <- .5
my.data.2 <- transform(my.data, my.y=my.y + x.dist)

. Теперь я существенно изменил ваши функции, предлагаю вычислить строку по Строка, какие аргументы я использовал. Важно отметить, что я использую xpd=TRUE, чтобы иметь возможность строить за пределами региона. С par я немного расширяю джины mar. Я использую mtext вместе с axis, чтобы получить метки и метки. Чтобы сделать диагональную линию flu sh с осями, я использовал lines вместо abline. В bottom.triangle2 теперь используется points вместо plot, поскольку plot не имеет аргумента add=TRUE. И я использую asp=1 в top.triangle2, чтобы сделать равносторонние треугольники. 

top.triangle2 <- function() {
  plot(my.y ~ my.x, data= my.data, axes=FALSE, ylab='', xlab="", 
       main='', xlim=c(0, 1), ylim=c(0, 1), xaxt="n", yaxt="n", asp=1)
  mtext("Here could be your title", 3, 5, font=2, cex=1.3, adj=.95)
  mtext("Position.2", 2, .75)
  mtext("Position.1", 3, 2)
  axis(side=2, las=1, pos=0)
  axis(side=3, las=1, pos=1)
  lines(0:1, 0:1)
}

bottom.triangle2 <- function() {
  points(my.x ~ my.y, data=my.data.2, xpd=TRUE)
  mtext("Position.2", 1, 1.5, at=mean(par()$usr[1:2]) + x.dist)
  mtext("Position.1", 4, 3, padj=par()$usr[1] + 10)
  x.at <- axisTicks(par()$usr[1:2], 0) + x.dist
  axis(side=1, las=1, pos=0, at=x.at, 
       labels=F, xpd=TRUE)
  mtext(seq(0, 1, .2), 1, 0, at=x.at)
  axis(4, las=1, pos=1 + x.dist)
  lines(0:1 + x.dist, 0:1, xpd=TRUE)
}

Я использую png, чтобы получить воспроизводимый вывод. 

png("myplot.png", width=650, height=500)
op <- par(mar=c(3, 4, 8, 12) + 0.1, oma=c(2, 0, 0, 2))
top.triangle2()
bottom.triangle2()
par(op)
dev.off()

Результат

enter image description here

Возможно, вы сами придумаете, как избежать такого сложного кодирования.

...