Finding Y value corresponding to a particular X - r

Question

I'm trying to find the precision value corresponding to a cutoff threshold of 0.5, as part of my model evaluation (logistic regression).
I get numeric(0) after instead of the Y value.
y_hat = predict(mdl, newdata=ds_ts, type="response")
pred = prediction(y_hat, ds_ts$popularity)
perfPrc = performance(pred, "prec")
xPrc = perfPrc#x.values[[1]]
# Find the precision value corresponds to a cutoff threshold of 0.5
prc = yPrc[c(0.5000188)] # perfPrc isn't continuous - closest value to 0.5
prc # output is 'numeric(0)' `

Answer 1

Try this (assuming that you have the model object mdl with you, also assuming that your response variable popularity has 2 levels 1 (positive) and 0), by applying the definition of precision (you can try some approximate kNN based non-parametric methods to aggregate precision values at nearby cutoffs present, OR fit curves as Precision=f(Cutoff) to find Precision at unknown Cutoff, but that will be approximate again, instead going by definition of precision will give you the correct result):
p <- predict(mdl, newdata=ds_ts, type='response') # compute the prob that the output class label is 1
test_cut_off <- 0.5 # this is the cut off value for which you want to find precision
preds <- ifelse(p > test_cut_off, 1, 0) # find the class labels predicted with the new cut off
prec <- sum((preds == 1) & (ds_ts$popularity == 1)) / sum(preds == 1) # TP / (TP + FP)
[EDITED}
Try the following simple experiment with randomly generated data (you can test with your own data).
set.seed(1234)
ds_ts <- data.frame(x=rnorm(100), popularity=sample(0:1, 100, replace=TRUE))
mdl <- glm(popularity~x, ds_ts, family=binomial())
y_hat = predict(mdl, newdata=ds_ts, type="response")
pred = prediction(y_hat, ds_ts$popularity)
perfPrc = performance(pred, "prec")
xPrc = perfPrc#x.values[[1]]
yPrc = perfPrc#y.values[[1]]
plot(xPrc, yPrc, pch=19)
test_cut_off <- 0.5 # this is the cut off value for which you want to find precision
# Find the precision value corresponds to a cutoff threshold, since it's not there you can't get this way
prc = yPrc[c(test_cut_off)] # perfPrc isn't continuous
prc #
# numeric(0)
# workaround: 1-NN, use the precision at the neasrest cutoff to get an approximate precision, the one you have used should work
nearest_cutoff_index <- which.min(abs(xPrc - test_cut_off))
approx_prec_at_cutoff <- yPrc[nearest_cutoff_index]
approx_prec_at_cutoff
# [1] 0.5294118
points(test_cut_off, approx_prec_at_cutoff, pch=19, col='red', cex=2)
The red point represents the approximate precision (it may be exactly equal to the actual precision if we are lucky).
# use average precision from k-NN
k <- 3 # 3-NN
nearest_cutoff_indices <- sort(abs(xPrc - test_cut_off), index.return=TRUE)$ix[1:k]
approx_prec_at_cutoff <- mean(yPrc[nearest_cutoff_indices])
approx_prec_at_cutoff
# [1] 0.5294881
points(test_cut_off, approx_prec_at_cutoff, pch=19, col='red', cex=2)
p <- predict(mdl, newdata=ds_ts, type='response')
preds <- ifelse(p > 0.5000188, 1, 0)
actual_prec_at_cutoff <- sum((preds == 1) & (ds_ts$popularity == 1)) / sum(preds == 1) # TP / (TP + FP)
actual_prec_at_cutoff
# [1] 0.5294118