使用lda()
在R中完成线性判别分析后,是否有方便的方法为每个组提取classification functions?
从链接
不要将这些与判别函数混淆。分类函数可用于确定每个案例最可能属于哪个组。分组功能与组相同。每个函数允许我们通过应用公式计算每个组的每个案例的分类分数:
Si = ci + wi1*x1 + wi2*x2 + ... + wim*xm
在该公式中,下标i表示各自的组;下标1,2,...,m表示m个变量; ci是第i组的常数,wij是计算第i组分类得分时第j个变量的权重; xj是第j个变量的相应情况的观测值。 Si是得分分数。
我们可以使用分类函数直接计算一些新观察的分类分数。
我可以使用教科书公式从头开始构建它们,但这需要重建lda分析中的许多中间步骤。有没有办法从lda对象中获取它们?
加了:
除非我仍然在布兰登的回答中误解了一些事情(对不起这个混乱!),似乎答案是肯定的。据推测,大多数用户可以从predict()
获取所需信息,lda()
提供基于{{1}}的分类。
答案 0 :(得分: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"
答案 1 :(得分:0)
我认为你的问题存在缺陷......好吧,也许没有缺陷,但至少有些误导。判别函数是指组之间的距离,因此没有与单个组相关联的函数,而是描述任何两个组质心之间的距离的函数。我只是answered a more recent question并且放置了一个使用虹膜数据集计算得分函数的示例,并使用它来标记预测变量的2d图中的案例。在2组分析的情况下,一组的函数大于零,而另一组的函数小于零。
答案 2 :(得分:0)
没有内置的方法来获取我需要的信息,所以我写了一个函数来做到这一点:
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的Numerical Ecology(1998),第625页中的公式,并匹配从第626页开始的工作示例的结果。