Nothing
#' Exclusivity
#'
#' Calculate an exclusivity metric for an STM model.
#'
#' In Roberts et al 2014 we proposed using the Mimno et al 2011 \code{\link{semanticCoherence}} metric
#' for helping with topic model selection. We found that semantic coherence alone is relatively easy to
#' achieve by having only a couple of topics which all are dominated by the most common words. Thus we
#' also proposed an exclusivity measure.
#'
#' Our exclusivity measure includes some information on word frequency as well. It is based on the FREX
#' labeling metric (\code{\link{calcfrex}}) with the weight set to .7 in favor of exclusivity by default.
#'
#' This function is currently marked with the keyword internal because it does not have much error checking.
#'
#' @param model the STM object
#' @param M the number of top words to consider per topic
#' @param frexw the frex weight
#'
#' @return a numeric vector containing exclusivity for each topic
#'
#' @references
#' Mimno, D., Wallach, H. M., Talley, E., Leenders, M., & McCallum, A. (2011, July).
#' "Optimizing semantic coherence in topic models." In Proceedings of the Conference on Empirical Methods in
#' Natural Language Processing (pp. 262-272). Association for Computational Linguistics. Chicago
#'
#' Bischof and Airoldi (2012) "Summarizing topical content with word frequency and exclusivity"
#' In Proceedings of the International Conference on Machine Learning.
#'
#' Roberts, M., Stewart, B., Tingley, D., Lucas, C., Leder-Luis, J., Gadarian, S., Albertson, B., et al. (2014).
#' "Structural topic models for open ended survey responses." American Journal of Political Science, 58(4), 1064-1082.
#' @seealso \code{\link{searchK}} \code{\link{plot.searchK}} \code{\link{semanticCoherence}}
#' @keywords internal
#' @examples
#' exclusivity(gadarianFit)
#' @export
exclusivity <- function(model, M=10, frexw=.7){
w <- frexw
if(length(model$beta$logbeta)!=1) stop("Exclusivity calculation only designed for models without content covariates")
tbeta <- t(exp(model$beta$logbeta[[1]]))
s <- rowSums(tbeta)
mat <- tbeta/s #normed by columns of beta now.
ex <- apply(mat,2,rank)/nrow(mat)
fr <- apply(tbeta,2,rank)/nrow(mat)
frex<- 1/(w/ex + (1-w)/fr)
index <- apply(tbeta, 2, order, decreasing=TRUE)[1:M,]
out <- vector(length=ncol(tbeta))
for(i in 1:ncol(frex)) {
out[i] <- sum(frex[index[,i],i])
}
out
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.