Find the y-coordinate at the intersection of two curves, when x is known

Question

Background and Summary of Purpose

I am trying to find the y-coordinate at the intersection of two constructed curves using R. I will give you full information and examples of the data below, but in the hope that this is a simple problem, I will be more brief front.

The cumulative frequencies of the two curves (c1 and c2 for simplicity) are determined by the following function, where a and b are the known coefficients: F (X) = 1 / (1 + exp (- (a + BX)))

Using the uniroot () function, I found "x" at the intersection of c1 and c2.

I suggested that if x is known, then the definition of y should be a simple substitution: for example, if x = 10, y = 1 / (1 + exp (- (a + b * 10))) (again, a and b - known values); however, as will be shown below, this is not so.

The purpose of this post is to determine how to find the y coordinate.

More details

These data reproduce the stated price of the respondents, in which they believe that the price of the product is also too low. (that is, they doubt its quality) and the price at which they consider the product to be a deal.

• Data will be cleared before use to ensure that too.cheap is always less than the transaction price.
• The total frequency for the transaction price will be inverted to become not.bargain.
• The intersection of the transaction and too.cheap will represent the point at which an equal proportion of respondents consider that the price is not a transaction and too.cheap is the point of low cost ("pmc").

Getting to the point where I am having a call will take a few steps.

Step 1. Creating some data

# load libraries for all steps
library(car)
library(ggplot2)

# function that generates the data
so.create.test.dataset <- function(n, mean){

  step.to.bargain <- round(rnorm(n = n, 3, sd = 0.75), 2)
  price.too.cheap <- round(rnorm(n = n, mean = mean, sd = floor(mean * 100 / 4) / 100), 2)
  price.bargain <- price.too.cheap + step.to.bargain 

  df.temp <- cbind(price.too.cheap,
                 price.bargain)
  df.temp <- as.data.frame(df.temp)

  return(df.temp)
}
# create 389 "observations" where the too.cheap has a mean value of 10.50
# the function will also create a "bargain" price by 
#adding random values with a mean of 3.00 to the too.cheap price

so.test.df <- so.create.test.dataset(n = 389, mean = 10.50)

Step 2. Creating a data frame with cumulative frequencies

so.get.count <- function(p.points, p.vector){
  cc.temp <- as.data.frame(table(p.vector))
  cc.merged <- merge(p.points, cc.temp, by.x = "price.point", by.y = "p.vector", all.x = T)
  cc.extracted <- cc.merged[,"Freq"]
  cc.extracted[is.na(cc.extracted)] <- 0
  return(cc.extracted)
}

so.get.df.price<-function(df){
  # creates cumulative frequencies for three variables 
  # using the price points provided by respondents

  # extract and sort all unique price points
  # Thanks to akrun for their help with this step
  price.point <- sort(unique(unlist(round(df, 2))))

  #create a new data frame to work with having a row for each price point
  dfp <- as.data.frame(price.point)

  # Create cumulative frequencies (as percentages) for each variable
  dfp$too.cheap.share <- 1 - (cumsum(so.get.count(dfp, df$price.too.cheap)) / nrow(df))
  dfp$bargain.share <- 1 - cumsum(so.get.count(dfp, df$price.bargain)) / nrow(df)
  dfp$not.bargain.share <- 1 - dfp$bargain.share# bargain inverted so curves will intersect

  return(dfp)  
} 

so.df.price <- so.get.df.price(so.test.df)

Step 3: Evaluate Cumulative Frequency Curves

# Too Cheap
so.l <- lm(logit(so.df.price$too.cheap.share,  percents = TRUE)~so.df.price$price.point)
so.cof.TCh <- coef(so.l)
so.temp.nls <- nls(too.cheap.share ~ 1 / (1 + exp(-(a + b * price.point))), start = list(a = so.cof.TCh[1], b = so.cof.TCh[2]), data = so.df.price, trace = TRUE)
so.df.price$Pr.TCh <- predict(so.temp.nls, so.df.price$price.point, lwd=2)

#Not Bargain
so.l <- lm(logit(not.bargain.share, percents = TRUE) ~ price.point, so.df.price)
so.cof.NBr <- coef(so.l)
so.temp.nls <- nls(not.bargain.share ~ 1 / (1 + exp(-(a + b * price.point))), start = list(a = so.cof.NBr[1], b = so.cof.Br[2]), data= so.df.price, trace=TRUE)
so.df.price$Pr.NBr <- predict(so.temp.nls, so.df.price$price.point, lwd=2)

# Thanks to John Fox & Sanford Weisberg - "An R Companion to Applied Regression, second edition"

""

ggplot(data = so.df.price, aes(x = price.point))+
  geom_line(aes(y = so.df.price$Pr.TCh, colour = "Too Cheap"))+
  geom_line(aes(y = so.df.price$Pr.NBr, colour = "Not Bargain"))+
  geom_line(aes(y = so.df.price$too.cheap.share, colour = "too.cheap.share"))+
  geom_line(aes(y = so.df.price$not.bargain.share, colour = "not.bargain.share"))+
  scale_y_continuous(name = "Cummulative Frequency")

, -, .

4:

so.f <- function(x, a, b){
  # model for the curves
  1 / (1 + exp(-(a + b * x)))
} 
# note, this function may also be used in step 3 
#I was building as I went and I don't want to risk a transpositional error that breaks the example

so.pmc.x <- uniroot(function(x) so.f(x, so.cof.TCh[1], so.cof.TCh[2]) - so.f(x, so.cof.Br[1], so.cof.Br[2]), c(0, 50), tol = 0.01)$root

so.pmc.x, . , so.pmc.x too.cheap not.bargain.

ggplot(data = so.df.price, aes(x = price.point)) +
  geom_line(aes(y = so.df.price$Pr.TCh, colour = "Too Cheap")) +
  geom_line(aes(y = so.df.price$Pr.NBr, colour = "Not Bargain")) +
  scale_y_continuous(name = "Cumulative Frequency") +
  geom_vline(aes(xintercept = so.pmc.x))

... .

5: y

, , - .

f (x) = 1/(1 + exp (- (a + bx))), a, b x , y 1/(1 + exp (- (a + bx))) ?

.

# We attempt to use the too.cheap estimate to find y
so.pmc.y <- so.f(so.pmc.x, so.cof.TCh[1], so.cof.TCh[2])

# In theory, y for not.bargain at price.point so.pmc.x should be the same
so.pmc.y2 <- so.f(so.pmc.x, so.cof.NBr[1], so.cof.NBr[2])

EDIT: (. ). a!= so.cof.NBr [1] b!= so.cof.NBr [2], a be so.temp.nls(not so.l)

# Which they are
#> so.pmc.y
#(Intercept) 
# 0.02830516 
#> so.pmc.y2
#(Intercept) 
#  0.0283046 

y, yintercept = so.pmc.y, too.cheap not.bargain.

... , , .

, y?

Answer 1

, , , .

, y = 1/(1 + exp (- (a + bx))) .

, a, b.

so.cof.NBr, .

#Not Bargain
so.l <- lm(logit(not.bargain.share, percents = TRUE) ~ price.point, so.df.price)
so.cof.NBr <- coef(so.l)
so.temp.nls <- nls(not.bargain.share ~ 1 / (1 + exp(-(a + b * price.point))), start = list(a = so.cof.NBr[1], b = so.cof.Br[2]), data= so.df.price, trace=TRUE)
so.df.price$Pr.NBr <- predict(so.temp.nls, so.df.price$price.point, lwd=2)

so.temp.nls, NOT so.l.

, so.pmc.x, so.temp.nls y.

# extract coefficients from so.temp.nls
so.co <- coef(so.temp.nls)

# find y
so.pmc.y <- 1 / (1 + exp(-(so.co[1] + so.co[2] * so.pmc.x)))

ggplot(data = so.df.price, aes(x = price.point))+
  geom_line(aes(y = so.df.price$Pr.TCh, colour = "Too Cheap"))+
  geom_line(aes(y = so.df.price$Pr.NBr, colour = "Not Bargain"))+
  scale_y_continuous(name = "Cumulative Frequency")+
  geom_hline(aes(yintercept = so.pmc.y))

...

.