R, ggplot2:如何绘制通过固定坐标的bezier曲线?

我正在帮助某人将手绘的经济供需函数翻译成可以包含在Word文档中的图像文件。在Andrew Heiss的侦察图和他的curve_intersect函数的基础上，使用Hmisc::bezier和geom_path模型，这些都进行得很顺利。也就是说，直到作者要求其中一条供给曲线应该经过一组指定的坐标。bezier函数只使用第一个和最后一个控制点作为绝对控制点，并向中间点弯曲，因此指定的交点与曲线不匹配。我尝试用bezier软件包(v1.1.2, https://cran.r-project.org/web/packages/bezier/bezier.pdf)中的bezier函数创建2条bezier曲线的样条，但这失败了" 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, 9, 9), 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, xend = x, yend = 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
,aes(x = x, y = y, 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, 0), breaks = c(intersections$y, 9)
,labels = c(expression(P[CR]==frac("$",brl))
,expression(P[CR]))
,limits=c(0,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, 4, 5), c(9, 6.5, 6, 5.5)) %>%
as_data_frame()
demand_capacity <- Hmisc::bezier(c(5, 5), c(0, 5.5)) %>%
as_data_frame()
supply_capacity <- Hmisc::bezier(c(4.999, 5), c(0, 9)) %>%
as_data_frame()
supply_label_height <- Hmisc::bezier(c(0, 9), c(9, 9)) %>%
as_data_frame()
demand_label_height <- Hmisc::bezier(c(0, 9), c(8, 8)) %>%
as_data_frame()
capacity_label_height <- Hmisc::bezier(c(0, 9), c(9, 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, color = "#0073D9", size = 1) + 
geom_path(data = demand, color = "#FF4036", size = 1) +
geom_path(data = demand_capacity, color = "#FF4036", size = 1) +
geom_path(data = supply_capacity, color = "#0073D9", size = 1, lty = "dashed") +
geom_segment(data = intersections, 
aes(x = 0, y = y, xend = x, yend = y), lty = "dotted") + 
geom_text_repel(data = labels
,aes(x = x, y = y, label = label) 
,parse = TRUE
,direction = "x"
,force = 3
,force_pull = 0.1
,hjust = c(0, 0, 1)
,min.segment.length = 0
) +
geom_point(data = intersections, size = 3) +
scale_x_continuous(expand = c(0, 0), breaks = c(intersections$x
, 5),
labels = c(expression(paste(Q[CR]^{DRL-OS},phantom(12345)))
,expression(Q[CR]^CAP)
)
, limits=c(0,9)) +
scale_y_continuous(expand = c(0, 0), breaks = c(intersections$y, 9),
labels = c(expression(P[CR]),expression(P[CR]))
, limits=c(0,9)) +
labs(x = "Barrels",
caption = expression(atop("(b) Driller Storage / Ownership", "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()

相关部分


# panel (c)
# ggforce package method
#supply <- list(c(1, 4, specified_intersections$x, 5, 7),
#                        c(3, 4, 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, 4, specified_intersections$x, 7, 8), 
c(3, 4, specified_intersections$y, 6, 9))
#p <- matrix(c(1,3, 4,4, specified_intersections$x,specified_intersections$y,
#              7,6, 8,9), 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, specified_intersections$x, 8), 
#                        c(3, specified_intersections$y, 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, 4, specified_intersections$x), 
#                         c(3, 4, specified_intersections$y)) %>%
#  as_data_frame()
#supply2 <- Hmisc::bezier(c(specified_intersections$x, 6, 7), 
#                         c(specified_intersections$y, 8, 9)) %>%
#  as_data_frame()
#demand <- Hmisc::bezier(c(0, 9), c(specified_intersections$y, specified_intersections$y)) %>%
#  as_data_frame()
label_height <- Hmisc::bezier(c(0, 9), c(8, 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, color = "#0073D9", size = 1) +

# Original geom_path method  
geom_path(data = supply, color = "#0073D9", size = 1) + 
# Supply 1 and 2 for Hmisc method
#  geom_path(data = supply1, color = "#0073D9", size = 1) + 
#  geom_path(data = supply2, color = "#0073D9", size = 1) + 
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, xend = x, yend = y), lty = "dotted") + 
#  geom_text_repel(data = labels
#                  ,aes(x = x, y = y, label = label) 
#                  ,parse = TRUE
#                  ,direction = "x"
#                  ,force = 3
#                  ,force_pull = 0.1
#                  ,hjust = 0
#                  ,min.segment.length = 0
#  ) +
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, 0), breaks = c(specified_intersections$y, 9),
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

固定坐标实现前的图形。需要移动面板(c)交点以匹配面板(a)

解决了FUN(X[[I]]，…):object ' X ' not found"通过打印供给变量并注意到贝塞尔函数将其行命名为V1、V2而不是x、y。我需要将geom_path的美观性设置为正确的映射。

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

相关部分，只保留bezier方法

相关内容

最新更新

热门标签：