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'