Автоматично преоразмеряване на персонализиран знак за изчертаване?

Здравейте всички, надявам се да има някой, който може да ми помогне с начертаването на направен по поръчка pch в R. В моя случай се опитвам да създам графика, свързана с качеството на водата във времето. Един от начините за наблюдение на качеството на водата е да се използва секи диск, който е основно метален диск с четвъртинки от диска, боядисани в черно и бяло (вижте диаграмата по-долу).

Досега успях успешно да създам диска и да го поставя върху парцел, но проблемът ми идва с ефект на разтягане в зависимост от размерите на парцела.

Ето функцията, която съм използвал за създаване на диска досега:

# 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 файл и да опитам да начертая импортирания файл. Мисли за този подход?

Благодаря за всяка помощ.

r plot pch

s_scolary 05.11.2015 източник

Отговори (1)

arrow_upward
1
arrow_downward

Мисля, че имам решение. Ако не, трябва да съм много близо. Проблемът е, че във вашата функция диаметърът е еднакъв за оста x и оста y, независимо от диапазона от данни. Казано по друг начин, диапазонът на оста на годините е 45, а диапазонът на оста на дълбочината е ~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)
}

Pierre Lapointe 06.11.2015

comment

Това изглежда фантастично. Благодаря ви много за помощта. - s_scolary; 07.11.2015

Автоматично преоразмеряване на персонализиран знак за изчертаване?

Отговори (1)

Подобни въпроси