Original Link: <https://www.reddit.com/r/Rlanguage/comments/kmdwv1/how_to_group_by_and_use_ggplot2_for_funnel_plot/>
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 ...
ggplot(datMain, aes(x = x)) +
geom_line(aes(y = yUpper)) +
geom_line(aes(y = yLower))
# 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)