Подъемная кривая поменялась местами

Question

Для примера для кривой подъема я запускаю

library(caret)
set.seed(1)
simulated <- data.frame(obs = factor(rep(letters[1:2], each = 100)),
                        perfect = sort(runif(200), decreasing = TRUE),
                        random = runif(200))
lift2 <- lift(obs ~ random + perfect, data = simulated)
xyplot(lift2, plot = "lift", auto.key = list(columns = 2))

и получите

как результат. Я ожидал, что изображение будет изменено по горизонтали - что-то вроде

Что я делаю не так?

Кстати: это график лифта, а не кумулятивный график прибыли.

Обновление:

Сюжет, который я ожидал, создан теперь моим собственным кодом

mylift <- caret::lift(Class ~ cforest_prob + perfect_prob + guess_prob, data = data_test)
ggplot(mylift$data) +
  geom_line(aes(CumTestedPct, lift, color = liftModelVar))

есть

Я заметил, что data.frame mylift$data содержит следующие столбцы:

names(mylift$data)
 [1] "liftModelVar" "cuts"         "events"       "n"            "Sn"           "Sp"           "EventPct"    
 [8] "CumEventPct"  "lift"         "CumTestedPct"

Итак, я напечатал следующий сюжет

ggplot(mylift$data) +
  geom_line(aes(cuts, lift, color = liftModelVar))

Итак, я думаю, что разные графики - это просто разные способы изучения лифта? Я не знал, что есть разные диаграммы подъема - я думал, что они были стандартизированы по всей отрасли.

Answer 1

Редактировать автор вопроса, для поздних читателей : я принял этот ответ в значительной степени из-за полезного обсуждения в комментариях к этому ответу. Пожалуйста, ознакомьтесь с обсуждением!

---

Давайте воспроизведем график и найдем базовую линию. Пусть

cutoffs <- seq(0, 1, length = 1000)

будь нашим отсечением. Теперь основные вычисления сделаны

aux <- sapply(cutoffs, function(ct) {
  perf <- simulated$obs[simulated$perfect > ct]
  rand <- simulated$obs[simulated$random > ct]
  c(mean(perf == "a"), mean(rand == "a"))
})

, где мы проходим вектор срезов и делаем следующее. Возьмите случай perfect. Мы говорим, что всякий раз, когда perfect > ct, мы будем предсказывать "a". Тогда simulated$obs[simulated$perfect > ct] - это истинные значения, а mean(perf == "a") - наша точность с заданным значением отсечения. То же самое происходит с random.

Что касается базовой линии, то это просто константа, определяемая долей "a" в выборке:

baseline <- mean(simulated$obs == "a")

При построении лифтов мы делим нашу точность на метод базовой линии и получаем тот же график вместе с базовой линией:

plot(x = cutoffs, y = aux[1, ] / baseline, type = 'l', ylim = c(0, 2), xlab = "Cutoff", ylab = "Lift")
lines(x = cutoffs, y = aux[2, ] / baseline, col = 'blue')
abline(a = baseline / baseline, b = 0, col = 'magenta')

Обновление

Вот иллюстрация того, что, по крайней мере, при рисовании вручную, кривой подъема «ожидаемого» типа можно манипулировать и давать неуникальные результаты.

Ваш примерный график взят из здесь , который также имеет эти данные:

#   contacted response
# 1      10000     6000
# 2      20000    10000
# 3      30000    13000
# 4      40000    15800
# 5      50000    17000
# 6      60000    18000
# 7      70000    18800
# 8      80000    19400
# 9      90000    19800
# 10    100000    20000

Теперь предположим, что мы знаем не эту эволюцию, а 10 отдельных блоков:

#    contacted response
# 1      10000     6000
# 2      10000     4000
# 3      10000     3000
# 4      10000     2800
# 5      10000     1200
# 6      10000     1000
# 7      10000      800
# 8      10000      600
# 9      10000      400
# 10     10000      200

В этом случае это зависит от того, как мы упорядочим наблюдения, когда ставим «% соприкосновения» по оси x:

set.seed(1)
baseline <- sum(df$response) / sum(df$contacted) * cumsum(df$contacted)
lift1 <- cumsum(df$response)
lift2 <- cumsum(sample(df$response))
x <- 1:10 * 10

plot(x = x, y = lift1 / baseline, col = 'red', type = 'l', ylim = c(0, 3), xlab = "% Customers contacted", ylab = "Lift")
lines(x = x, y = lift2 / baseline, col = 'blue')
abline(a = baseline / baseline, b = 0, col = 'magenta')