R 从geom_区域获取区域大小（离散值）

我想用ggplot2得到曲线下的面积。问题是我只有连续尺度（时间）上的离散值（测量值，因变量），但测量值之间的距离并不相等。我对拟合一个函数不感兴趣（我试图进行分析），只对绘图下的区域感兴趣

我知道我可以计算x值之间的平均值，然后做“离散积分”。但我认为可能有一种更简单的方法来获得面积大小，因为我使用

geom\u area

在ggplot2中绘制了整个图形。所以我得到了一个整洁的填充区域，但是有没有可能从

geom_area

中提取区域大小

编辑：下面是一些很好的解决方案，用于计算仅给出离散值的曲线下的面积。尽管如此，如果有人知道是否可以通过

geom_面积

简单地提取面积大小，我非常想知道

可复制示例：

mydata <- data.frame(time = c(2,4,6,8,19,24,30,43,48,69),
                     ratio = c(0.24, 1.04, 1.08, 1.27, 2.12, 2.13, 2.34, 2.00, 1.90, 1.96))

ggplot(data = mydata, aes(x = time, y = ratio))+
  geom_area(fill = "grey")+
  geom_point(colour = "red")+
  labs(title = "My sample data", y = "Ratio", x = "Time")

---

mydata考虑后续点之间的灰色多边形区域。它由两种形状组成


高度从y=0到两个y值中较低者的矩形，宽度为x1-x0
高度为y0和y1之差，宽度为x1-x0的三角形


如果我们为每一个后续的点对计算这些面积，我们就可以将这些面积相加，得到总面积

mydata %>% 
  arrange(time) %>% 
  mutate(area_rectangle = (lead(time) - time) * pmin(ratio, lead(ratio)),
         area_triangle = 0.5 * (lead(time) - time) * abs(ratio - lead(ratio))) %>% 
  summarise(area = sum(area_rectangle + area_triangle, na.rm = TRUE))

为了获得区域大小，我使用了rgeos库。试试这个

# load the rgeos library
library(rgeos)

# make a polygon (borrowed from ref manual for package)
sample_polygon <- readWKT("POLYGON((2 0,2 0.24,4 1.04,6 1.08,8 1.27,19 2.12,24 2.13,30 2.34,43 2.00,48 1.90,69 1.96,69 0,2 0))")

# and calculate the area
gArea(sample_polygon)
[1] 126.92

#加载rgeos库
图书馆（rgeos）
#制作一个多边形（从包装参考手册中借用）
示例_polygon我们也可以通过对线下的面积求和来计算积分面积，如下面的代码和图所示：

mydata <- data.frame(time = c(2,4,6,8,19,24,30,43,48,69),
                     ratio = c(0.24, 1.04, 1.08, 1.27, 2.12, 2.13, 2.34, 2.00, 1.90, 1.96))

ggplot(data = mydata, aes(x = time, y = ratio))+
  geom_area(fill = "grey")+
  geom_point(colour = "red")+
  geom_vline(xintercept=mydata$time) + 
  labs(title = "My sample data", y = "Ratio", x = "Time") 

mydata您可以使用pracma包中的函数，您可以得到与上面相同的结果

library(pracma)

mydata <- data.frame(time = c(2,4,6,8,19,24,30,43,48,69),
                     ratio = c(0.24, 1.04, 1.08, 1.27, 2.12, 2.13, 2.34, 2.00, 1.90, 1.96))

#for cumulative areas

cumtrapz(mydata$time, mydata$ratio)

         [,1]
 [1,]   0.000
 [2,]   1.280
 [3,]   3.400
 [4,]   5.750
 [5,]  24.395
 [6,]  35.020
 [7,]  48.430
 [8,]  76.640
 [9,]  86.390
 [10,] 126.920


#for total area

trapz(mydata$time, mydata$ratio)

[1] 126.92

库（pracma）
我的数据谢谢你的回答，我理解数学，因为这是我最初的想法，但后来不知道如何在R中巧妙地做到这一点。玩弄循环，但不相信我的结果。所以你的代码看起来很短，但是我试过了，它不起作用，
lead
是你自己的功能吗？
%%>%%
是什么意思？
lead
位于
dplyr
中。
%%>%%
是将函数链接在一起的管道。也就是说，
f（a，b）
与
a%>%f（b）
相同。明白了。似乎是一个大包裹，我的笔记本现在无法处理它…所以我必须稍后再试。无论如何，谢谢你的帮助！不错！唯一的问题是，我如何将我的数据粘贴到由
readWKT
读取的表单中？找到了一个简单的方法，可以谨慎使用，因为我不能100%确定此函数是否以相同的方式运行-看起来是这样的：
auc
来自package
flux
（也在
auc
）-计算给定
x
和
y
的曲线下面积。在我读到的描述中，它使用了梯形规则，这似乎与@Axeman所做的相同。哇，多么好的代码！有多少种不同的方法给我留下了深刻的印象。老实说，我会坚持以上简单/快速的解决方案，因为我需要计算几次。。。无论如何，谢谢你的努力！谢谢@Spreeprinte，但我想上面的代码速度很快，概念上也很容易理解。
get.line.slope <- function(x1, y1, x2, y2) {
  (y2 - y1) / (x2 - x1)
}

get.line.intercept <- function(x1, y1, x2, y2) {
  y1 - (y2 - y1)*x1 / (x2 - x1)
}

st.lines <- as.data.frame(t(sapply(1:(nrow(mydata)-1), 
  function(i) c(
    m=get.line.slope(mydata$time[i],mydata$ratio[i], mydata$time[i+1], mydata$ratio[i+1]),
    c=get.line.intercept(mydata$time[i],mydata$ratio[i], mydata$time[i+1], mydata$ratio[i+1]),
    startx=mydata$time[i],
    endx=mydata$time[i+1]))))   

st.lines # as can be seen there are 9 st. lines with slope m, intercept c
# we have to find the area under each line from left vertical line at startx to 
# right vertical line at endx

#              m          c startx endx
# 1  0.400000000 -0.5600000      2    4
# 2  0.020000000  0.9600000      4    6
# 3  0.095000000  0.5100000      6    8
# 4  0.077272727  0.6518182      8   19
# 5  0.002000000  2.0820000     19   24
# 6  0.035000000  1.2900000     24   30
# 7 -0.026153846  3.1246154     30   43
# 8 -0.020000000  2.8600000     43   48
# 9  0.002857143  1.7628571     48   69

ggplot(data = mydata, aes(x = time, y = ratio))+
  geom_area(fill = "grey")+
  geom_point(colour = "red")+
  geom_vline(xintercept=mydata$time) + 
  geom_abline(data=st.lines, aes(slope=m, intercept=c), col='blue', lty=2) +
  labs(title = "My sample data", y = "Ratio", x = "Time") 

# compute the area under each of the blue dotted lines in between the black vertical lines
areas <- apply(st.lines, 1, function(l) 
         integrate(f=function(x)l['m']*x+l['c'], 
         lower = l['startx'], upper=l['endx'])$value)
areas
# [1]  1.280  2.120  2.350 18.645 10.625 13.410 28.210  9.750 40.530

# total area under the polygon
sum(areas)
# [1] 126.92

library(pracma)

mydata <- data.frame(time = c(2,4,6,8,19,24,30,43,48,69),
                     ratio = c(0.24, 1.04, 1.08, 1.27, 2.12, 2.13, 2.34, 2.00, 1.90, 1.96))

#for cumulative areas

cumtrapz(mydata$time, mydata$ratio)

         [,1]
 [1,]   0.000
 [2,]   1.280
 [3,]   3.400
 [4,]   5.750
 [5,]  24.395
 [6,]  35.020
 [7,]  48.430
 [8,]  76.640
 [9,]  86.390
 [10,] 126.920


#for total area

trapz(mydata$time, mydata$ratio)

[1] 126.92