# Chapter 6 Posteriors

## r Function to calculate the likelihood of observing the disease given each topic

calculate_likelihood <- function(disease_occurred, beta_prime, active_topics, d, v, t) {
likelihood <- rep(0, K)
for (k in 1:K) {
if (active_topics[d, k, t] == 1) {
likelihood[k] <- beta_prime[d, k, v, t]
}
}
return(likelihood)
}

# Function to update topic weights based on new diagnostic information
update_topic_weights <- function(theta, disease_occurred, beta_prime, active_topics, d, t, gamma) {
for (v in 1:V) {
if (disease_occurred[d, v, t] == 1) {
likelihood <- calculate_likelihood(disease_occurred, beta_prime, active_topics, d, v, t)
posterior <- likelihood * theta[d, , t]
posterior <- posterior / sum(posterior)
theta[d, , t] <- posterior
}
}
return(theta)
}

# Initialize topic weights
theta <- array(0, dim = c(D, K, T))
for (d in 1:D) {
for (k in 1:K) {
for (t in 1:T) {
theta[d, k, t] <- Theta_individual[d, k, t]
}
}
}

# Update topic weights based on new diagnostic information
for (d in 1:D) {
for (t in 1:T) {
theta <- update_topic_weights(theta, disease_occurred, beta_prime, active_topics, d, t, gamma)
}
}

# Visualization of updated topic weights
theta_long <- melt(theta)
colnames(theta_long) <- c("Individual", "Topic", "Time", "Weight")

ggplot(theta_long, aes(x = Time, y = Weight, col = factor(Topic))) +
geom_smooth(se = FALSE) +
facet_wrap(~ Individual, ncol = 4, scales = "free_y") +

labs(title = "Updated Topic Weights Over Time", x = "Time", y = "Topic Weight", color = "Topic") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 90, hjust = 1))
## geom_smooth() using method = 'loess' and formula = 'y ~ x'
## Warning: Removed 2205 rows containing non-finite outside the scale range
## (stat_smooth()).

##

# Visualization of updated topic weights
theta_long <- melt(Theta_individual)
colnames(theta_long) <- c("Individual", "Topic", "Time", "Weight")

ggplot(theta_long, aes(x = Time, y = Weight, col = factor(Topic))) +
geom_smooth(se = FALSE) +
facet_wrap(~ Individual, ncol = 4, scales = "free_y") +

labs(title = "True Topic Weights Over Time", x = "Time", y = "Topic Weight", color = "Topic") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 90, hjust = 1))
## geom_smooth() using method = 'loess' and formula = 'y ~ x'

#detach("package:reshape", unload = TRUE)
library(reshape2)
m=melt(theta[1,,])
ggplot(m,aes(Var2,value,group=as.factor(Var1),fill=as.factor(Var1),col=as.factor(Var1)))+geom_smooth(se = FALSE)+theme_classic()+labs(fill="Topic",col="Topic",y="Estimated Topic Weight",x="Age")
## geom_smooth() using method = 'loess' and formula = 'y ~ x'
## Warning: Removed 35 rows containing non-finite outside the scale range
## (stat_smooth()).

m=melt(Theta_individual[1,,])
ggplot(m,aes(Var2,value,group=as.factor(Var1),fill=as.factor(Var1),col=as.factor(Var1)))+geom_smooth(se = FALSE)+theme_classic()+labs(fill="Topic",col="Topic",y="True Weight",x="Age")
## geom_smooth() using method = 'loess' and formula = 'y ~ x'