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

Question

I am helping someone translate hand-drawn economics supply and demand functions into image files that can be included in a Word document. These have been going well using Hmisc::bezier and geom_path modeled after Andrew Heiss's recon plots and using his curve_intersect function. That is, until the author asked that one of the supply curves should pass through a specified set of coordinates. The Hmisc::bezier function only uses the first and last control point as absolute, and bends toward intermediate points so the specified intersection point does not match the curve. I tried creating a spline of 2 bezier curves with the bezier function from the bezier package (v1.1.2, https://cran.r-project.org/web/packages/bezier/bezier.pdf ), but this fails with "Error in FUN(X[[i]], ...): object 'x' not found", which I do not understand or know how to fix.

Please let me know where I am going wrong or if there is a better method. I will include the commented out attempts using various functions, Please excuse the amateurish code. as I am a relative newb at R and ggplot2.

This section not directly relevant to my question

# 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()  

Relevant section

# 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

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

Answer 1

I solved the "Error in FUN(X[[i]], ...): object 'x' not found" by printing the supply variable and noticing that the bezier function names its rows V1,V2 and not x,y. I needed to set the aesthetics of the geom_path to the correct mapping.

Relevant Section, trimmed to only the bezier method

# panel (c)

# bezier package method
t <- seq(0, 2, length = 100)
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::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, xend = x, yend = 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, 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

This does not solve my larger problem of needing a smooth curve that passes through a specified set of coordinates, as it produces two bezier curves that do not match.

I will do some research on using functions to specify bezier curves and find out if there is some mathematical or programmatic way to specify a bezier curve that passes through a set of fixed coordinates. If I find one, I'll edit this answer.

If anyone knows how to accomplish this, I would appreciate any help!

Kinked bezier curves