inst/extdata/scripts/entropy_trajectory_visualization_igfr.R

In robertness/bninfo: Queries and information theoritic operations on Bayesian networks.

################################################################################
## Reshaping and visualization the data from the sim.
################################################################################
#source(system.file("extdata", "entropy_trajectory_visualization.Rdata", package = "bninfo"))
library(combinat)
library(ggplot2)
library(dplyr)
library(tidyr)

load("inst/extdata/sim_results/entropy_trajectory_simulations/IGFR_model/IGFR_averaging_entropies_directed_3-31-16_no_bayes_50iss.Rdata")
results <-   list(averaging_entropies_directed)
int_targets <- c("IGFR", "IRS", "PI3K", "GRB", "AKT", "MTOR")
permutations <- permn(int_targets)
results <- results %>%#, avg_entropies_undirected)
  lapply(function(result){
    lapply(result, function(item){
      data.frame(first = names(item)[2],
                 second = names(item)[3],
                 third = names(item)[4],
                 fourth = names(item)[5],
                 fifth = names(item)[6],
                 sixth = names(item)[7],
                 obs_val = item[1],
                 first_val = item[2],
                 second_val = item[3],
                 third_val = item[4],
                 fourth_val = item[5],
                 fifth_val = item[6],
                 sixth_val = item[7],
                 stringsAsFactors = F)
      })
  } %>%
    {plyr::ldply(.)})
results[[1]]$prior_info <- "directed_edges"
results_full <- tbl_df(plyr::ldply(results)) %>%
   group_by(prior_info, first) %>%
     mutate(first_val = mean(first_val)) %>%
     group_by(first, second) %>%
     mutate(second_val = mean(second_val)) %>%
     group_by(first, second, third) %>%
     mutate(third_val = mean(third_val)) %>%
     group_by(first, second, third, fourth) %>%
     mutate(fourth_val = mean(fourth_val)) %>%
     group_by(first, second, third, fourth, fifth) %>%
     mutate(fifth_val = mean(fifth_val)) %>%
     group_by(first, second, third, fourth, fifth, sixth) %>%
     mutate(sixth_val = mean(sixth_val)) %>%
     ungroup %>%
     unique %>%
     mutate(ordering = apply(.[c("first", "second", "third",
                                "fourth", "fifth", "sixth")],
                            1, paste, collapse = "-")) %>%
           select(-first, -second, -third, -fourth, -fifth, -sixth) %>%
    gather(experiment, entropy, obs_val:sixth_val) %>%
    mutate(experiment = ordered(experiment,
                              levels = c("obs_val", "first_val",
                                         "second_val", "third_val",
                                         "fourth_val", "fifth_val", "sixth_val")))

result <- filter(results_full, prior_info == "directed_edges")
best_label <- directed_prior_result %$%
  selected %>%
  paste0(collapse = "-")
result <- mutate(result, type = ifelse(ordering == best_label, "best", "not_best"))
# best_data <- no_prior_result$all_results[c(4, 8, 12, 16, 20)] %>%
#   lapply(function(item){
#     c(quantile(item, .025), mean(item), quantile(item, .975))
#   }) %>%
#   {do.call("rbind", .)} %>%
#   data.frame %>%
#   setNames(c("lower", "IG", "upper")) %>%
#   {rbind(c(NA,NA,NA), .)} %>%
#   {cbind(filter(result, type == "best"), .)}

ggplot(result, aes(x = experiment, y = entropy, group = ordering)) +
  geom_line(data = result,#filter(result, type != "best"),
            aes(group = ordering), alpha = 0.1) +
  ylim(c(-.05, 1)) +
  geom_line(data = best_data,
            aes(x = experiment, y = entropy, group = ordering), lwd = 1.5, colour = "red") +
  geom_line(data = best_data,
            aes(x = experiment, y = IG, group = ordering), colour = "blue") +
  geom_hline(yintercept = 0, lwd = 0.4) +
  geom_vline(xintercept = 4, lwd = 0.5, colour = "darkred") +
  geom_errorbar(data = best_data,  width=.1, colour = "blue",
                aes(x = experiment, y = IG, ymin = lower, ymax = upper, group = ordering))
########


result <- filter(results_full, prior_info == "directed_edges")
best_label <- paste0(directed_prior_result$selected, collapse="-")
result <- mutate(result, type = ifelse(ordering == best_label, "best", "not_best"))
best_data <- no_prior_result$all_results[c(4, 8, 12, 16, 20)] %>%
  lapply(function(item){
    c(quantile(item, .025), mean(item), quantile(item, .975))
  }) %>%
  {do.call("rbind", .)} %>%
  data.frame %>%
  setNames(c("lower", "IG", "upper")) %>%
  {rbind(c(NA,NA,NA), .)} %>%
  {cbind(filter(result, type == "best"), .)}

ggplot(result, aes(x = experiment, y = entropy, group = ordering)) +
  geom_line(data = filter(result, type != "best"),
            aes(group = ordering), alpha = 0.1) +
  geom_line(data = best_data,
            aes(x = experiment, y = entropy, group = ordering), lwd = 1.5, colour = "red") +
  geom_line(data = best_data,
            aes(x = experiment, y = IG, group = ordering), colour = "blue") +
  geom_hline(yintercept = 0, lwd = 0.4) +
  geom_vline(xintercept = 4, lwd = 0.5, colour = "darkred") +
  geom_errorbar(data = best_data,  width=.1, colour = "blue",
                aes(x = experiment, y = IG, ymin = lower, ymax = upper, group = ordering)) +
  ylim(c(-.05, 1))