Скажем, у меня 200 субъектов, 100 в группе A и 100 в группе B, и для каждого я измеряю некоторый непрерывный параметр.

require(ggplot2)
set.seed(100)

value <- c(rnorm(100, mean = 5, sd = 3), rnorm(100, mean = 10, sd = 3))
group <- c(rep('A', 100), rep('B', 100))

data <- data.frame(value, group)

ggplot(data = data, aes(x = value)) +
  geom_bar(aes(color = group))

Я хотел бы определить значение (Порог? Точка останова?), Которое максимизирует разделение и минимизирует ошибочную классификацию между группами. Существует ли такая функция в R?

Я пробовал искать по строкам «максимальное разделение точки останова r между группами» и «порог r минимизирует ошибочную классификацию», но мой google-foo, похоже, сегодня отключен.

РЕДАКТИРОВАТЬ:

Отвечая на комментарий @ Thomas, я попытался подогнать данные с помощью логистической регрессии, а затем решить для порога, но я не продвинулся очень далеко.

lr <- glm(group~value)
coef(lr)
# (Intercept)       value 
# 1.1857435  -0.0911762

Итак, Bo = 1,1857435 и B1 = -0,0911762

Из Википедии я вижу, что F (x) = 1 / (1 + e ^ - (Bo + B1x)) и решение относительно x:

Х = (ln (F (x) / (1 - F (x))) - Bo) / B1

Но попробовав это в R, я получаю явно неверный ответ:

(log(0.5/(1 - 0.5)) - 1.1857435)/-0.0911762 # 13.00497
r
1
sudo make install 10 Апр 2014 в 06:20

2 ответа

Лучший ответ

Я получил нужный мне ответ благодаря помощи @Thomas и @BenBolker.

Резюме

  • Проблема с моей попыткой решить ее с помощью логистической регрессии заключалась в том, что я не указал family = binomial
  • Функция dos.p () в MASS выполнит всю работу за меня, учитывая соответствие glm

Код

# Include libraries
require(ggplot2)
require(MASS)

# Set seed
set.seed(100)

# Put together some dummy data
value <- c(rnorm(100, mean = 5, sd = 3), rnorm(100, mean = 10, sd = 3))
group <- c(rep(0, 100), rep(1, 100))
data <- data.frame(value, group)

# Plot the distribution -- visually
# The answer appears to be b/t 7 and 8
ggplot(data = data, aes(x = value)) +
  geom_bar(aes(color = group))

# Fit a glm model, specifying the binomial distribution
my.glm <- glm(group~value, data = data, family = binomial)
b0 <- coef(my.glm)[[1]]
b1 <- coef(my.glm)[[2]]

# See what the probability function looks like
lr <- function(x, b0, b1) {
  prob <- 1 / (1 + exp(-1*(b0 + b1*x)))
  return(prob)                  
}

# The line appears to cross 0.5 just above 7.5
x <- -0:12
y <- lr(x, b0, b1)
lr.val <- data.frame(x, y)
ggplot(lr.val, aes(x = x, y = y)) +
  geom_line()

# The inverse of this function computes the threshold for a given probability
inv.lr <- function(p, b0, b1) {
  x <- (log(p / (1 - p)) - b0)/b1
  return(x)
}

# With the betas from this function, we get 7.686814
inv.lr(0.5, b0, b1)

# Or, feeding the glm model into dose.p from MASS, we get the same answer
dose.p(my.glm, p = 0.5)

Спасибо всем за вашу помощь!

1
sudo make install 10 Апр 2014 в 14:22

Простой подход - написать функцию, которая вычисляет точность с учетом порога:

accuracy = Vectorize(function(th) mean(c("A", "B")[(value > th) + 1] == group))

Затем найдите максимум, используя optimize:

optimize(accuracy, c(min(value), max(value)), maximum=TRUE)
# $maximum
# [1] 8.050888
# 
# $objective
# [1] 0.86
3
David Robinson 10 Апр 2014 в 11:14