0

大家好，我希望有人可以帮助我在 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 文件并尝试绘制导入的文件。对这种方法的想法？

谢谢你的帮助。

4

1 回答 1

1

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

    # 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)
}

在此处输入图像描述

于 2015-11-06T16:21:51.727 回答