R: point at which geom_smooth drops below a certain value - r

Question

Hi stack overflow community,
I hope the two interrelated questions I am asking are not too nooby. I tried several google searches but could not find a solution.
I use R to plot the findings of a linguistic "experiment", in which I checked in how far two grammatical constructions yield acceptable descriptions of an event, depending on how for it unfolds. My data look like similar to this:
event,PFV.alone,PFV.and.PART
0.01,0,1
0.01,0,1
0.05,0,1
0.05,0,1
0.05,0,1
0.1,0,1
0.1,0,1
0.25,0,1
0.25,0,1
0.25,0,1
0.3,0,1
0.3,0,1
0.33,0,1
0.33,0,1
0.33,0,1
0.33,0,1
....
0.67,1,0.5
0.75,1,0.5
0.75,1,0
0.75,1,0
0.75,1,0
0.8,1,1
0.8,1,0
0.8,1,0
0.8,1,0
0.85,1,1
0.85,1,0
0.9,1,0
0.9,1,0
0.9,1,0
0.95,1,0
As you can see, for each of the two constructions there are "plateaus" where acceptability is 0 or 1 and then there's a "transitional" area. In order to illustrate the "plateaus" I use geom_segment and to create a smooth "transition" for the scattered data in between, I use geom_smooth. Here's my code:
#after loading datafile into "Daten":
p <- ggplot(data = Daten,
aes(x=event, y=PFV.and.PART, xmin=0, ymin=0, xmax=1, ymax=1))
p + geom_blank() +
coord_fixed()+
xlab("Progress of the event") +
ylab("Acceptability") +
geom_segment(x=0, xend=1, y=0.5,yend=0.5, linetype="dotted") +
geom_smooth(data=(subset(Daten, event==0.33 | event ==0.9)),
aes(color="chocolate"),
method="loess", fullrange=FALSE, level=0.95, se=FALSE) +
geom_segment(x=0,xend=0.33,y=1,yend=1, color="chocolate", size=1) +
geom_segment(x=0.9,xend=1,y=0,yend=0, color="chocolate", size=1) +
geom_smooth(data=(subset(Daten, event==0.33 | event==0.67)),
aes(x = event, y = PFV.alone, color="cyan4"),
method="lm",fullrange=FALSE, level=0.95, se=FALSE) +
geom_segment(color="cyan4",x=0,xend=0.33,y=0,yend=0,size=1) +
geom_segment(color="cyan4", x=0.67,xend=1,y=1,yend=1, size=1) +
scale_x_continuous(labels = scales::percent) +
scale_y_continuous(breaks = c (0,0.5,1), labels = scales::percent)+
labs(color='Construction')+
scale_color_manual(labels = c("PFV + PART", "PFV alone"),
values = c("chocolate", "cyan4")) +
theme(legend.position=c(0.05, 0.8),
legend.justification = c("left", "top"),
legend.background = element_rect(fill = "darkgray"))
This code produces a nice graph, but there's one calculation and one plot-related issue that I need help with.
First, and most importantly, I'd like to find out, at what point exactly the geom_smooth (loess) curve for "PFV.and.PART" drops down to 0.5, i.e. hits 50% acceptability. I fear that this might involve some quiet complex code?
Related to the preceding point, I'd like to mark area/line, where both curves are above 0.5 (50% acceptability), or to speak in terms of what I am trying to show: the percentages of the event at which both constructions yield a description that is at least 50% acceptable. This, of course would be based on point 1, as it is neceessary to determine the right limit, whereas the left limit does not constitute a problem as it seems to lie at x=0.5,y=0.5.
I'd really appreciate any help and I hope that I have provided all the necessary information. Please excuse me if this question has been addressed elsewhere.

Answer 1

Here's one approach, which involves fitting a loess model outside of ggplot
# Generate some data
set.seed(2019)
my_dat <- c(sample(c(1,0.5, 0),33, prob = c(0.85,0.15,0), replace = TRUE),
sample(c(1,0.5, 0),33, prob = c(0.1,0.7,0.1), replace = TRUE),
sample(c(1,0.5,0),34, prob = c(0,0.15,0.85), replace = TRUE))
df <- tibble(x = 1:100, y = my_dat)
# fit a loess model
m1 <- loess(y~x, data = df)
df <- df %>%
add_column(pred = predict(m1)) # predict using the loess model
# plot
df %>%
ggplot(aes(x,y))+
geom_point() +
geom_line(aes(y = pred))
# search for a value of x that gives a prediction of 0.5
f <- function(x) { 0.5 - predict(m1)[x]}
uniroot(f, interval = c(1, 100))
# $root
# [1] 53.99997