首页 文章

如何在某些点之后绘制一个形状(椭圆或椭圆)并计算其面积?

提问于
浏览
1

我试图绘制树木的环并计算它们的面积 . 但是,我注意到实际上并非所有环都具有像圆一样的对称半径 . 我有4个半径的数据测量,我想在每个无线电的每个点之后绘制环(或任何类似的形状),例如这个例子(这个图是用PowerPoint中的向量手动完成的):

enter image description here

问题是在R中我发现只有用 symbols() 函数中的 circles 选项绘制这些环的可能性,我得到了这个图:
enter image description here

使用这个R脚本:

data <- data.frame(
a = c(1,4,5,8, 10),
b = c(1, 3,7,9, 10),
c = c(2, 6, 8, 9 ,10),
d = c(1, 3, 4, 7, 9) )

data$y <- (data$a - data$b)/2 # y position
data$x <- (data$d - data$c)/2 # x position
data$z <- rowMeans(data[,1:4]) # radio length

symbols(x = data$x, y = data$y, circles=data$z, 
        xlim = c(-10, 10)*1.5, ylim = c(-10, 10)*1.5, inches = F, fg = "orange", lwd = 2)

我已经检查了一些包含函数的包来绘制省略号( elliplotellipseellipseplotcar 等),但我不喜欢它们的功能 . 我对使用这些软件包不感兴趣,相反我想写一个自己的代码 .

我的想法是用四个半径的数据值绘制一个最符合环的真实图形的形状,它可以是椭圆形,椭圆形等 .

我用一个圆圈只使用一个无线电的数据(在我的例子中,所有半径的平均值) . 使用椭圆会更好,因为我可以使用至少两个值,长轴(A B)和短轴(C D) . 但绘制一个使用四个半径(A,B,C,D)或更多半径值的形状会很棒 .

Here一个人用R script吸引了一个非常好的superellipse,另一个吸引了一些ellipses likes ringsin R .

但是,我不知道如何将他们的方法用于我的具体问题 .

如果有人知道如何开始绘制R中的至少一个椭圆会很好 . 但是很高兴知道如何使用四个半径的值绘制一个形状(椭圆形,椭圆形等)并最终计算它们的面积 .

我非常感谢你的帮助或任何指导 .

更新:

感谢@ cuttlefish44的优秀答案,这对于向学生解释树木生长非常有用 . 然而,大多数热带树木的形状非常不规则,现在我想知道我是否可以使用额外的无线电“E”绘制另一个形状,并且半径轴位于不同位置,如此方案:

irregular stem shape

任何方向对我都非常有用 .

1 回答

  • 1

    如果A和B在y轴上并且C&D在x轴上,则不难计算椭圆的参数 . 我使用 optim() 来获取参数(注意:这种方法有很小的错误,例如2.439826e-12) .
    数据操作

    # change all data into xy coordinates and make ring-factor
    library(reshape2); library(dplyr)
    
    data <- data.frame(
      a = c(1, 4, 5, 8, 10),
      b = c(1, 3, 7, 9, 10) * -1,
      c = c(2, 6, 8, 9, 10) * -1,
      d = c(1, 3, 4, 7, 9) )
    
    data <- t(data)
    colnames(data) <- LETTERS[1:ncol(data)]   # ring-factor
    df <- melt(data, value.name = "x")        # change into long-form
    
    df$y <- df$x                              # make xy coordinates
    df[df$Var1=="a"|df$Var1=="b", "x"] <- 0
    df[df$Var1=="c"|df$Var1=="d", "y"] <- 0
    

    计算中心坐标,ox&oy

    center <- df %>% group_by(Var2) %>% summarize(sum(x)/2, sum(y)/2) %>% as.data.frame()
    

    计算椭圆参数;半主要和-minor轴,ra&rb

    opt.f <- function(par, subset, center) {     # target function
      ox <- center[[1]]                          # par[1] and par[2] are ra and rb
      oy <- center[[2]]
      x <- subset$x
      y <- subset$y
      sum(abs((x - ox)^2/par[1]^2 + (y - oy)^2/par[2]^2 - 1))   # from ellipse equation
    }
    
    lev <- levels(df$Var2)
    
    ## search parameters
    res <- sapply(1:length(lev), function(a) 
      optim(c(1,1), opt.f, subset = subset(df, Var2 == lev[a]), 
            center = center[a, 2:3], control = list(reltol = 1.0e-12)))
    
    res  # result. you can get detail by res[,1etc]. values are not 0 but much nearly 0
    

    函数绘图(可能一些包有类似的一个)

    radian <- function(degree) degree/180*pi
    plot.ellipse <- function(ox, oy, ra, rb, phi=0, start=0, end=360, length=100, func=lines, ...) {
      theta <- c(seq(radian(start), radian(end), length=length), radian(end))
      if (phi == 0) {
        func(ra*cos(theta)+ox, rb*sin(theta)+oy, ...)
      } else {
        x <- ra*cos(theta)
        y <- rb*sin(theta)
        phi <- radian(phi)
        cosine <- cos(phi)
        sine <- sin(phi)
        func(cosine*x-sine*y+ox, sine*x+cosine*y+oy, ...)
      }
    }
    

    draw

    plot(0, type="n", xlim=c(-10, 10), ylim =c(-10, 10), asp=1, xlab="x", ylab="y", axes = F)
    axis(1, pos=0);axis(2, pos=0, las=2)
    points(df$x, df$y)
    for(a in 1:length(lev)) plot.ellipse(ox = center[a, 2], oy = center[a, 3], 
                                         ra = res[,a]$par[1], rb = res[,a]$par[2], length=300)
    
    area <- sapply(res[1,], function(a) pi * a[1] * a[2])
    

    enter image description here

相关问题