Original Post

Original Link: <https://www.reddit.com/r/Rlanguage/comments/kmdwv1/how_to_group_by_and_use_ggplot2_for_funnel_plot/>

Build the data set

library(tidyverse)

GetValues <- function(pNumVals, pMean, pSD) {
  return(rnorm(pNumVals, pMean, pSD))
}

# Make the data
yMean <- 100
yBaseCV <- 0.01
yConstCV <- 0.005
yConstSD <- yMean * yConstCV
intervalStart <- yMean
intervalStop <- yMean +  3 * yConstSD
sN <- 1000

datMain <- tibble(
  x = seq(intervalStart, intervalStop, length.out = sN),
  yUpper = yMean + 1 * dnorm(x, yMean, x * yBaseCV) + yConstSD,
  yLower = yMean - 1 * dnorm(x, yMean, x * yBaseCV) - yConstSD,
)

str(datMain)

xvals <- seq(intervalStart, intervalStop, length.out = sN)
nSize <- 5

datSimulated <- tibble(
  x = rep(xvals, nSize),
  y = numeric(length(x))
)

for (i in 1:length(xvals)) {
  indexStart <- nSize * (i - 1) + 1
  indexStop <- nSize * i

  datSimulated[indexStart:indexStop, ]$x <- xvals[i]
  datSimulated[indexStart:indexStop, ]$y <- GetValues(nSize, yMean, (yMean * yConstCV / xvals[i] + yConstSD) / 1)
}
## tibble [1,000 x 3] (S3: tbl_df/tbl/data.frame)
##  $ x     : num [1:1000] 100 100 100 100 100 ...
##  $ yUpper: num [1:1000] 101 101 101 101 101 ...
##  $ yLower: num [1:1000] 99.1 99.1 99.1 99.1 99.1 ...

Create the plots

Plot the limit values

ggplot(datMain, aes(x = x)) +
  geom_line(aes(y = yUpper)) +
  geom_line(aes(y = yLower))

Plot the data values

# Set up the color values
## Initially, this line sets all color values. However, at the end of processing,
## only values in the 'middle' region will have this color.
datSimulated <- datSimulated %>%
  mutate(colVal = alpha("yellow", 0.5), ptShape = 21)

## Set the color for the values greater than 'upper' threshold
with(
  datSimulated,
  {
    datSimulated[y >= yMean + dnorm(x, yMean, x * yBaseCV) + yConstSD, ]$colVal <<- "red"
    datSimulated[y >= yMean + dnorm(x, yMean, x * yBaseCV) + yConstSD, ]$ptShape <<- 23
  }
)

## Set the color for the values lower than 'lower' threshold
with(
  datSimulated,
  {
    datSimulated[y <= yMean - dnorm(x, yMean, x * yBaseCV) - yConstSD, ]$colVal <<- "green"
    datSimulated[y <= yMean - dnorm(x, yMean, x * yBaseCV) - yConstSD, ]$ptShape <<- 24
  }
)

lSize <- 2
lColor <- alpha("red", 1)
ggplot() +
  geom_point(aes(x = x, y = y), datSimulated, size = 3, fill = datSimulated$colVal, shape = datSimulated$ptShape) +
  geom_line(aes(x = x, y = yUpper), datMain, size = lSize, color = lColor) +
  geom_line(aes(x = x, y = yLower), datMain, size = lSize, color = lColor)