In kkdey/ordtpx: Estimation of Topic Models with Ordered Features using Multi-resolution analysis

Simulation design

library(ordtpx)
library(inline)
#library(Rcpp)
library(ordtpx)
library(maptpx)
library(slam)
library(smashr)

nclus <- 2;
del_beta <- c(2,10,50, 100, 500, 1000, 2000);
levels <- 8

a_mu <- 30;
b_mu <- 80;

mu_tree_set <- lapply(1:nclus, function(s) return(mra_tree_prior_mu(levels,del_beta, a_mu, b_mu)));
param_set <- param_extract_mu_tree(mu_tree_set)

prior_calc <- prior_calc_fn(param_set, del_beta, a_mu, b_mu)

theta_sim <- do.call(rbind, lapply(1:nclus, function(l) mu_tree_set[[l]][[levels]]/mu_tree_set[[l]][[1]]));

n.out <- 200
omega_sim <- rbind( cbind( rep(1, n.out), rep(0, n.out)),
                  cbind( rep(0, n.out), rep(1, n.out)),
                  cbind( seq(0.6, 0.4, length.out = n.out),
                         1- seq(0.6, 0.4,length.out=n.out)) )
dim(omega_sim)
K <- dim(omega_sim)[2]

barplot(t(omega_sim),
        col = 2:(K+1),
        axisnames = F, space = 0, border = NA,
        main=paste("No. of clusters=", K),
        las=1, ylim=c(0,1), cex.axis=1.5, cex.main=1.4)


counts <- t(do.call(cbind,lapply(1:dim(omega_sim)[1], function(x) rmultinom(1,1000,prob=omega_sim[x,]%*%theta_sim))));

True theta

plot(theta_sim[1,], type="l")
plot(theta_sim[2,], type="l")

maptpx

We first apply maptpx package.

topic_clus <- maptpx::topics(counts, K=2, tol=0.1)

maptpx omega

K <- 2
barplot(t(topic_clus$omega),
        col = 2:(K+1),
        axisnames = F, space = 0, border = NA,
        main=paste("No. of clusters=", K),
        las=1, ylim=c(0,1), cex.axis=1.5, cex.main=1.4)

maptpx theta

plot(topic_clus$theta[,1], type="l")
plot(topic_clus$theta[,2], type="l")

ordtpx- bash

source("../R/ord_count.R")
source("../R/ord_mra.R")
source("../R/ord_tpx.R")
source("../R/tpx.R")
source("../R/ord_topics.R")
source("../R/count.R")
source("../R/binshrink.R")

K <- 2

system.time(ord_topics <- ord_topics(counts, K=2, ztree_options=1, tol=0.1, 
                    adapt.method="bash", init_method = "kmeans", acc=TRUE));

barplot(t(ord_topics$omega),
        col = 2:(K+1),
        axisnames = F, space = 0, border = NA,
        main=paste("No. of clusters=", K),
        las=1, ylim=c(0,1), cex.axis=1.5, cex.main=1.4)

bash omega

barplot(t(ord_topics$omega),
        col = 2:(K+1),
        axisnames = F, space = 0, border = NA,
        main=paste("No. of clusters=", K),
        las=1, ylim=c(0,1), cex.axis=1.5, cex.main=1.4)

bash theta

plot(ord_topics$theta[,1], type="l")
plot(ord_topics$theta[,2], type="l")

ordtpx- smash

K <- 2

system.time(ord_topics <- ord_topics(counts, K=2, ztree_options=1, tol=100, 
                    adapt.method="smash", init_method = "kmeans", acc=TRUE,
                    burn_trials=5));

barplot(t(ord_topics$omega),
        col = 2:(K+1),
        axisnames = F, space = 0, border = NA,
        main=paste("No. of clusters=", K),
        las=1, ylim=c(0,1), cex.axis=1.5, cex.main=1.4)

smash omega

barplot(t(ord_topics$omega),
        col = 2:(K+1),
        axisnames = F, space = 0, border = NA,
        main=paste("No. of clusters=", K),
        las=1, ylim=c(0,1), cex.axis=1.5, cex.main=1.4)

smash theta

plot(ord_topics$theta[,1], type="l")
plot(ord_topics$theta[,2], type="l")

kkdey/ordtpx documentation built on May 20, 2019, 10:36 a.m.