自动调整自定义绘图角色的大小？

Question

嘿大家我希望有人可以帮助我在R中绘制定制的pch。在我的情况下，我试图创建一个与水质有关的图表。监测水质的一种方法是使用一个secchi圆盘，它基本上是一个金属圆盘，圆盘的四分之一涂成黑色和白色（见下图）。

到目前为止，我已经能够成功创建光盘并将其放在一个情节中，但我的问题是根据绘图的尺寸来提供拉伸效果。

以下是我到目前为止用于制作光盘的功能：

# A circle function to draw a circle (pulled form another stackoverflow page)

circleFun <- function(center=c(0,0), diameter=1, npoints=100, start=0, end=2, filled=TRUE){
  tt <- seq(start*pi, end*pi, length.out=npoints)
  df <- data.frame(
    x = center[1] + diameter / 2 * cos(tt),
    y = center[2] + diameter / 2 * sin(tt)
  )
  if(filled==TRUE) { #add a point at the center so the whole 'pie slice' is filled
    df <- rbind(df, center)
  }
  return(df)
}

# and my function to create a secchi disc
secchiDisc = function(x,y,diameter = 1){
  quarterCircle1 = circleFun(c(x,y),diameter = diameter, start=0, end=0.5)
  quarterCircle3 = circleFun(c(x,y),diameter = diameter, start=1, end=1.5)
  fullCircle = circleFun(c(x, y), diameter, start=0, end=2)
  polygon(quarterCircle1$x,quarterCircle1$y,col="black")
  polygon(quarterCircle3$x,quarterCircle3$y,col="black")
  polygon(fullCircle$x,fullCircle$y)
}

# make a plot to show what it looks like
par(mar = c(5, 4, 4, 2) + 0.1)
plot(0,0,pch = "")
secchiDisc(0,0)

# create data frame 
data = as.data.frame(list(Year = 1970:2015,
                          Depth = rnorm(46,3,1)))

# and create a time series plot showing changes in depth over time
plot(data$Year,data$Depth,pch="",ylim = c(7,0))
for(i in 1:nrow(data)){
  secchiDisc(data$Year[i],data$Depth[i])
}

所以这是在绘制时间序列时的样子：

显然我可以横向拉伸曲线，直到它清理干净，但我想知道是否有人有关于如何根据情节自动让光盘重新调整大小的任何建议？

我试图自定义圆形功能以允许拉伸效果，但无济于事。我认为“拉伸效应”方法的一个问题是我仍然希望光盘看起来像圆形，但是我无法使圆的直径独立于x或y维度而改变。

我的另一个想法是将secchi光盘的空白图保存为png文件，并尝试绘制导入的文件。关于这种方法的想法？

感谢您的帮助。

Answer 1

我想我有一个解决方案。如果没有，我必须非常接近。问题是在您的函数中，x轴和y轴的直径相同，与数据范围无关。换句话说，年轴的范围是45，深度轴的范围是~5。当您尝试将相同直径的单位应用于两个轴时，圆的形状会变形。我的解决方案是计算x轴和y轴范围的比率。然后，该比率将应用于sin中的circleFun行。我不确定该比率是否应除以sqrt(2)，但它有效。此外，在绘制图表后，不应手动调整绘图窗口的大小。在窗口中使用win.graph或在绘图前使用mac中的quartz()。

    # A circle function to draw a circle (pulled form another stackoverflow page)

circleFun <- function(center=c(0,0), diameter=1, npoints=100, start=0, end=1, filled=TRUE,ratio=1){
  tt <- seq(start*pi, end*pi, length.out=npoints)
  df <- data.frame(
    x = center[1] + diameter / 2 * cos(tt),
    y = center[2] + diameter/ratio / 2 * sin(tt)
  )
  if(filled==TRUE) { #add a point at the center so the whole 'pie slice' is filled
    df <- rbind(df, center)
  }
  return(df)
}

# and my function to create a secchi disc
secchiDisc = function(x,y,diameter = 1,ratio=1){
  quarterCircle1 = circleFun(c(x,y),diameter = diameter, start=0, end=0.5,ratio=ratio)
  quarterCircle3 = circleFun(c(x,y),diameter = diameter, start=1, end=1.5,ratio=ratio)
  fullCircle = circleFun(c(x, y), diameter, start=0, end=2,ratio=ratio)
  polygon(quarterCircle1$x,quarterCircle1$y,col="black")
  polygon(quarterCircle3$x,quarterCircle3$y,col="black")
  polygon(fullCircle$x,fullCircle$y)
}

data = as.data.frame(list(Year = 1970:2015,
                          Depth = rnorm(46,3,1)))

xx <-diff(range(data$Year))
yy <-diff(range(data$Depth))
ratio=(xx/yy)/sqrt(2)
plot(data$Year,data$Depth,pch="")
for(i in 1:nrow(data)){
  secchiDisc(data$Year[i],data$Depth[i],diameter = 1.5,ratio=ratio)
}