################################################################################
## 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/no_prior_edges/averaging_entropies_vanilla_3-8-16_no_bayes_1000iss.Rdata")
load("inst/extdata/sim_results/entropy_trajectory_simulations/with_prior_edges/averaging_entropies_directed_3-8-16_no_bayes_1000iss.Rdata")
load("inst/extdata/sim_results/active_learning_results/no_prior_result_3-8-16_iss1000.Rdata")
load("inst/extdata/sim_results/active_learning_results/directed_prior_result_3-8-16_iss1000.Rdata")
results <- list(averaging_entropies_vanilla, averaging_entropies_directed)
int_targets <- c("PKC", "Akt", "PKA", "PIP2", "Mek")
permutations <- permn(int_targets)
results <- results %>%#, avg_entropies_undirected)
lapply(function(item){
for(i in 1:length(permutations)){
names(item[[i]]) <- c("obs", permutations[[i]])
}
item
}) %>%
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],
obs_val = item[1],
first_val = item[2],
second_val = item[3],
third_val = item[4],
fourth_val = item[5],
fifth_val = item[6],
stringsAsFactors = F)
})
} %>%
{plyr::ldply(.)})
results[[1]]$prior_info <- "none"
results[[2]]$prior_info <- "directed_edges"
#results[[3]]$prior_info <- "undirected_edges"
#results[[4]]$prior_info <- "bl_only"
#results[[5]]$prior_info <- "undirected_bl"
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)) %>%
ungroup %>%
unique %>%
mutate(ordering = apply(.[c("first", "second", "third",
"fourth", "fifth")],
1, paste, collapse = "-")) %>%
select(-first, -second, -third, -fourth, -fifth) %>%
gather(experiment, entropy, obs_val:fifth_val) %>%
mutate(experiment = ordered(experiment,
levels = c("obs_val", "first_val",
"second_val", "third_val",
"fourth_val", "fifth_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))
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.