R，ggplot2：如何绘制通过固定坐标的贝塞尔曲线？

问题描述

我正在帮助某人将手绘的经济学供求函数翻译成可以包含在 Word 文档中的图像文件。使用 Hmisc::bezier 和以 Andrew Heiss 的侦察图为模型建模的 geom_path 并使用他的 curve_intersect 函数，这些工作进展顺利。也就是说，直到作者要求其中一条供给曲线应该通过一组指定的坐标。 Hmisc::bezier 函数仅使用第一个和最后一个控制点作为绝对控制点，并向中间点弯曲，因此指定的交点与曲线不匹配。我尝试使用 bezier 包 (v1.1.2,https://cran.r-project.org/web/packages/bezier/bezier.pdf) 中的 bezier 函数创建 2 条贝塞尔曲线的样条，但这失败了“FUN(X[[i]],...) 错误：找不到对象“x””，我不明白或不知道如何解决。

请让我知道我哪里出错了或者是否有更好的方法！我将使用各种功能包括注释掉的尝试。请原谅我的业余代码，因为我是 R 和 ggplot2 的相对新手。

这部分与我的问题没有直接关系

# Graph figures for physical economics,negative oil prices paper

library(reconPlots)
library(dplyr)
library(ggplot2)
library(patchwork)
library(ggrepel)
library(bezier)
library(ggforce)

options(ggrepel.max.time = 1)
options(ggrepel.max.iter = 20000)

#Set seed value for ggrepel
set.seed(52)

# panel (a) 

#Set values of curves using the bezier function,each pair of c() values
# is an xy coordinate,and the sets of coordinates control the shape of the
# curve
supply <- Hmisc::bezier(c(1,5,6),c(3,4,9)) %>%
  as_data_frame()

demand <- Hmisc::bezier(c(0,9,9),c(6,6,6)) %>%
  as_data_frame()

label_height <- Hmisc::bezier(c(0,c(8,8,8)) %>%
  as_data_frame()

# Calculate the intersections of the two curves
intersections <- bind_rows(curve_intersect(supply,demand))

# Calculate point where the curve label(s) intersect a specified height
supply_label <- bind_rows(curve_intersect(supply,label_height))

labels <- data_frame(label = expression("PS"[CR]^DRL),x = supply_label$x,y = supply_label$y)                      

production <- ggplot(mapping = aes(x = x,y = y)) + 
  #Draw the supply curve. Demand is not drawn in this figure,but the
  # intersections of an imaginary demand curve are used to illustrate P0
  # and Q0,the intersection point,and the dotted lines
  geom_path(data = supply,color = "#0073D9",size = 1) + 
  geom_segment(data = intersections,aes(x = x,y = 0,xend = x,yend = y),lty = "dotted") +
  geom_segment(data = intersections,aes(x = 0,y = y,lty = "dotted") + 
  #Draw the supply curve label using the intersection calculated above,using
  # GGrepel so that the labels do not overlap the curve line
  geom_text_repel(data = labels,label = label),parse = TRUE,direction = "x",force = 3,force_pull = 0.1,hjust = 0,min.segment.length = 0
  ) +
  #Draw the intersection point based on intersection function between supply
  # and the phantom flat demand curve at height y=6
  geom_point(data = intersections,size = 3) +
  #Use scale functions to set y-axis label,axis intersection point labels,# and limits of the viewing area
  scale_x_continuous(expand = c(0,0),breaks = intersections$x,labels = expression(Q[CR]^{DRL-PS}),limits=c(0,9)
  ) +
  scale_y_continuous(expand = c(0,breaks = c(intersections$y,labels = c(expression(P[CR]==frac("$",brl)),expression(P[CR])),9)
  ) +
  #Use labs function to set x-axis title and title of each graph using the
  # caption function so that it displays on the bottom
  labs(x = expression(frac(Barrels,Week)),caption = expression(atop("(a) Driller Production Supply","of Crude Oil"))
  ) +
  #Set classic theme,x-axis title on right-hand side using larger font of
  # relative size 1.2,graph title on left-hand side using same larger font
  theme_classic() + 
  theme(axis.title.y = element_blank(),axis.title.x = element_text(hjust = 1),axis.text = element_text(size=rel(1.2)),plot.caption = element_text(hjust = 0.5,size=rel(1.2))
  ) + 
  coord_equal()

# Save the intersections so we can set the same quantity,price for panel (c)
specified_intersections = intersections

# Panel (b)
supply <- Hmisc::bezier(c(3.99,4),c(0,9)) %>%
  as_data_frame()

demand <- Hmisc::bezier(c(2,3,5),c(9,6.5,5.5)) %>%
  as_data_frame()

demand_capacity <- Hmisc::bezier(c(5,5.5)) %>%
  as_data_frame()

supply_capacity <- Hmisc::bezier(c(4.999,9)) %>%
  as_data_frame()

supply_label_height <- Hmisc::bezier(c(0,9)) %>%
  as_data_frame()

demand_label_height <- Hmisc::bezier(c(0,8)) %>%
  as_data_frame()

capacity_label_height <- Hmisc::bezier(c(0,9)) %>%
  as_data_frame()

# Calculate the intersections of the two curves
intersections <- bind_rows(curve_intersect(supply,demand))

supply_label <- bind_rows(curve_intersect(supply,supply_label_height))
demand_label <- bind_rows(curve_intersect(demand,demand_label_height))
capacity_label <- bind_rows(curve_intersect(supply_capacity,capacity_label_height))

labels <- data_frame(label = c(expression("OD"[CR]^DRL),expression("OS"[CR]^DRL),expression("Q"[CR]^CAP)
),x = c(demand_label$x,supply_label$x,capacity_label$x
),y = c(demand_label$y,supply_label$y,capacity_label$y
)
) 

inventory <- ggplot(mapping = aes(x = x,y = y)) + 
  geom_path(data = supply,size = 1) + 
  geom_path(data = demand,color = "#FF4036",size = 1) +
  geom_path(data = demand_capacity,size = 1) +
  geom_path(data = supply_capacity,size = 1,lty = "dashed") +
  geom_segment(data = intersections,lty = "dotted") + 
  geom_text_repel(data = labels,hjust = c(0,1),min.segment.length = 0
  ) +
  geom_point(data = intersections,size = 3) +
  scale_x_continuous(expand = c(0,breaks = c(intersections$x,labels = c(expression(paste(Q[CR]^{DRL-OS},phantom(12345))),expression(Q[CR]^CAP)
                     ),9)) +
  scale_y_continuous(expand = c(0,labels = c(expression(P[CR]),9)) +
  labs(x = "Barrels",caption = expression(atop("(b) Driller Storage / Ownership","of Crude Oil"))
  ) +
  theme_classic() + 
  theme(axis.title.y = element_blank(),size=rel(1.2))
  ) + 
  coord_equal()  

相关部分

# panel (c)

# ggforce package method
#supply <- list(c(1,specified_intersections$x,7),#                        c(3,specified_intersections$y,7,9)) %>%
#  as_data_frame()

# bezier package method: Fails with "Error in FUN(X[[i]],...) : object 'x' not found"
t <- seq(0,2,length=10)
p <- list(c(1,8),9))
#p <- matrix(c(1,#              7,nrow=5,ncol=2,byrow=TRUE)
supply <- bezier(t=t,p=p) %>%
  as_data_frame()

# Original: Fails because it does not pass through the specified intersection
#supply <- Hmisc::bezier(c(1,9)) %>%
#  as_data_frame()

# Hmisc method: Fails because there is no way to get the two curves to appear
# contiguous
#supply1 <- Hmisc::bezier(c(1,specified_intersections$x),#                         c(3,specified_intersections$y)) %>%
#  as_data_frame()
#supply2 <- Hmisc::bezier(c(specified_intersections$x,#                         c(specified_intersections$y,9)) %>%
#  as_data_frame()

#demand <- Hmisc::bezier(c(0,c(specified_intersections$y,specified_intersections$y)) %>%
#  as_data_frame()

label_height <- Hmisc::bezier(c(0,8)) %>%
  as_data_frame()

# Calculate the intersections of the two curves
#intersections <- bind_rows(curve_intersect(supply,demand))

#supply_label <- bind_rows(curve_intersect(supply,#                                          label_height))

#labels <- data_frame(label = expression("SS"[CR]^DRL),#                     x = supply_label$x,#                     y = supply_label$y)                      

sales <- ggplot(mapping = aes(x = x,y = y)) + 
# ggforce package method
#  geom_bspline(data = supply,size = 1) +
  
# Original geom_path method  
  geom_path(data = supply,size = 1) + 
# Supply 1 and 2 for Hmisc method
#  geom_path(data = supply1,size = 1) + 
#  geom_path(data = supply2,size = 1) + 
  geom_segment(data = specified_intersections,lty = "dotted") +
  geom_segment(data = specified_intersections,lty = "dotted") + 
#  geom_text_repel(data = labels
#,label = label) 
#,parse = TRUE
#,direction = "x"
#,force = 3
#,force_pull = 0.1
#,hjust = 0
#,min.segment.length = 0
#  ) +
  geom_point(data = specified_intersections,breaks = specified_intersections$x,labels = expression(Q[CR]^{DRL-SS}),breaks = c(specified_intersections$y,expression(P[CR]))) +
  labs(x = expression(frac(Barrels,caption = expression(atop("(c) Driller Sales Supply",size=rel(1.2))
  ) + 
  coord_equal()  

patchwork <- (production | inventory | sales)
patchwork

Graphs before implementation of fixed coordinates. Need to move panel (c) intersection point to match panel (a)

解决方法

我通过打印供应变量并注意到贝塞尔函数将其行命名为 V1、V2 而不是 x，从而解决了“FUN(X[[i]],...) 中的错误：找不到对象‘x’”,y。我需要将 geom_path 的美学设置为正确的映射。

相关部分，仅修剪为贝塞尔方法

# panel (c)

# bezier package method
t <- seq(0,2,length = 100)
p <- matrix(c(1,3,4,specified_intersections$x,specified_intersections$y,7,6,8,9),nrow=5,ncol=2,byrow=TRUE)
supply <- bezier::bezier(t=t,p=p,deg=2) %>%
  as_data_frame()

sales <- ggplot(mapping = aes(x = x,y = y)) + 
  
# Original geom_path method  
  geom_path(data = supply,mapping = aes(x = V1,y = V2),color = "#0073D9",size = 1,inherit.aes = FALSE) + 
  geom_segment(data = specified_intersections,aes(x = x,y = 0,xend = x,yend = y),lty = "dotted") +
  geom_segment(data = specified_intersections,aes(x = 0,y = y,lty = "dotted") + 

  geom_point(data = specified_intersections,size = 3) +
  scale_x_continuous(expand = c(0,0),breaks = specified_intersections$x,labels = expression(Q[CR]^{DRL-SS}),limits=c(0,9)) +
  scale_y_continuous(expand = c(0,breaks = c(specified_intersections$y,labels = c(expression(P[CR]),expression(P[CR]))) +
  labs(x = expression(frac(Barrels,Week)),caption = expression(atop("(c) Driller Sales Supply","of Crude Oil"))
  ) +
  theme_classic() + 
  theme(axis.title.y = element_blank(),axis.title.x = element_text(hjust = 1),axis.text = element_text(size=rel(1.2)),plot.caption = element_text(hjust = 0.5,size=rel(1.2))
  ) + 
  coord_equal()  

patchwork <- (production | inventory | sales)
patchwork

这不能解决我需要一条通过指定坐标集的平滑曲线的更大问题，因为它会产生两条不匹配的贝塞尔曲线。

我将对使用函数指定贝塞尔曲线进行一些研究，并找出是否有某种数学或编程方法来指定通过一组固定坐标的贝塞尔曲线。如果我找到了，我会编辑这个答案。

如果有人知道如何做到这一点，我将不胜感激！

Kinked bezier curves