Классификационные функции в линейном дискриминантном анализе в R

Question

После завершения линейного дискриминантного анализа в R с использованием lda(), есть ли удобный способ извлечь классификационные функции для каждой группы?

По ссылке,

Их не следует путать с дискриминантными функциями. Классификационные функции могут использоваться для определения того, к какой группе вероятнее всего относится каждый случай. Классификационных функций столько же, сколько и групп. Каждая функция позволяет нам вычислить баллы классификации для каждого случая для каждой группы, применяя формулу:

Si = ci + wi1*x1 + wi2*x2 + ... + wim*xm

В этой формуле нижний индекс i обозначает соответствующую группу; индексы 1, 2, ..., m обозначают m переменных; ci - константа для i-й группы, wij - вес для j-й переменной в вычислении классификационной оценки для i-й группы; xj - наблюдаемое значение для соответствующего случая для j-й переменной. Si - итоговый результат классификации.

Мы можем использовать классификационные функции для непосредственного вычисления классификационных баллов для некоторых новых наблюдений.

Я могу построить их с нуля, используя формулы из учебников, но для этого требуется перестроить ряд промежуточных шагов из анализа lda. Есть ли способ получить их по факту из объекта lda?

Добавлено:

Если я до сих пор не понял что-то в ответе Брэндона (извините за путаницу!), Похоже, ответ - нет. Предположительно большинство пользователей могут получить необходимую информацию из predict(), которая предоставляет классификации на основе lda().

Answer 1

Предположим, что x - это ваш объект LDA:

x$terms

Вы можете получить пик на объекте, посмотрев на его структуру:

str(x)

Обновление:

Iris <- data.frame(rbind(iris3[,,1], iris3[,,2], iris3[,,3]),Sp = rep(c("s","c","v"), rep(50,3)))
train <- sample(1:150, 75)
table(Iris$Sp[train])
z <- lda(Sp ~ ., Iris, prior = c(1,1,1)/3, subset = train)
predict(z, Iris[-train, ])$class
str(z)
List of 10
 $ prior  : Named num [1:3] 0.333 0.333 0.333
  ..- attr(*, "names")= chr [1:3] "c" "s" "v"
 $ counts : Named int [1:3] 30 25 20
  ..- attr(*, "names")= chr [1:3] "c" "s" "v"
 $ means  : num [1:3, 1:4] 6.03 5.02 6.72 2.81 3.43 ...
  ..- attr(*, "dimnames")=List of 2
  .. ..$ : chr [1:3] "c" "s" "v"
  .. ..$ : chr [1:4] "Sepal.L." "Sepal.W." "Petal.L." "Petal.W."
 $ scaling: num [1:4, 1:2] 0.545 1.655 -1.609 -3.682 -0.443 ...
  ..- attr(*, "dimnames")=List of 2
  .. ..$ : chr [1:4] "Sepal.L." "Sepal.W." "Petal.L." "Petal.W."
  .. ..$ : chr [1:2] "LD1" "LD2"
 $ lev    : chr [1:3] "c" "s" "v"
 $ svd    : num [1:2] 33.66 2.93
 $ N      : int 75
 $ call   : language lda(formula = Sp ~ ., data = Iris, prior = c(1, 1, 1)/3, subset = train)
 $ terms  :Classes 'terms', 'formula' length 3 Sp ~ Sepal.L. + Sepal.W. + Petal.L. + Petal.W.
  .. ..- attr(*, "variables")= language list(Sp, Sepal.L., Sepal.W., Petal.L., Petal.W.)
  .. ..- attr(*, "factors")= int [1:5, 1:4] 0 1 0 0 0 0 0 1 0 0 ...
  .. .. ..- attr(*, "dimnames")=List of 2
  .. .. .. ..$ : chr [1:5] "Sp" "Sepal.L." "Sepal.W." "Petal.L." ...
  .. .. .. ..$ : chr [1:4] "Sepal.L." "Sepal.W." "Petal.L." "Petal.W."
  .. ..- attr(*, "term.labels")= chr [1:4] "Sepal.L." "Sepal.W." "Petal.L." "Petal.W."
  .. ..- attr(*, "order")= int [1:4] 1 1 1 1
  .. ..- attr(*, "intercept")= int 1
  .. ..- attr(*, "response")= int 1
  .. ..- attr(*, ".Environment")=<environment: R_GlobalEnv
  .. ..- attr(*, "predvars")= language list(Sp, Sepal.L., Sepal.W., Petal.L., Petal.W.)
  .. ..- attr(*, "dataClasses")= Named chr [1:5] "factor" "numeric" "numeric" "numeric" ...
  .. .. ..- attr(*, "names")= chr [1:5] "Sp" "Sepal.L." "Sepal.W." "Petal.L." ...
 $ xlevels: Named list()
 - attr(*, "class")= chr "lda"

Answer 2

Не существует встроенного способа получения необходимой мне информации, поэтому я написал для этого функцию:

ty.lda <- function(x, groups){
  x.lda <- lda(groups ~ ., as.data.frame(x))

  gr <- length(unique(groups))   ## groups might be factors or numeric
  v <- ncol(x) ## variables
  m <- x.lda$means ## group means

  w <- array(NA, dim = c(v, v, gr))

  for(i in 1:gr){
    tmp <- scale(subset(x, groups == unique(groups)[i]), scale = FALSE)
    w[,,i] <- t(tmp) %*% tmp
  }

  W <- w[,,1]
  for(i in 2:gr)
    W <- W + w[,,i]

  V <- W/(nrow(x) - gr)
  iV <- solve(V)

  class.funs <- matrix(NA, nrow = v + 1, ncol = gr)
  colnames(class.funs) <- paste("group", 1:gr, sep=".")
  rownames(class.funs) <- c("constant", paste("var", 1:v, sep = "."))

  for(i in 1:gr) {
    class.funs[1, i] <- -0.5 * t(m[i,]) %*% iV %*% (m[i,])
    class.funs[2:(v+1) ,i] <- iV %*% (m[i,])
  }

  x.lda$class.funs <- class.funs

  return(x.lda)
}

Этот код следует формулам Legendre и Legendre's Numeric Ecology (1998), стр. 625, и соответствует результатам обработанного примера, начиная со страницы 626.

Answer 3

Я думаю, что ваш вопрос был ошибочным ... Хорошо, возможно, не ошибочным, но, по крайней мере, несколько вводящим в заблуждение.Дискриминантная функция (и) относится к расстояниям между группами, поэтому нет функции, связанной с одной группой, а есть функция, которая описывает расстояния между любыми двумя групповыми центроидами.Я просто ответил на более свежий вопрос и поместил пример вычисления функции оценки с использованием набора данных радужной оболочки и его использования для обозначения случаев на 2-м графике предикторов.В случае анализа с двумя группами функция будет больше нуля для одной группы и меньше нуля для другой группы.