suppressPackageStartupMessages(library(dplyr))
suppressPackageStartupMessages(library(ggplot2))
suppressPackageStartupMessages(library(ggrepel))
suppressPackageStartupMessages(library(cowplot))
suppressPackageStartupMessages(library(RColorBrewer))
suppressPackageStartupMessages(library(ggpmisc))
suppressPackageStartupMessages(library(svglite))

# Load custom plotting functions
util_file = file.path("..", "6.biobombe-projection", "scripts", "utils.R")
source(util_file)

set.seed(123)

fig_extensions <- c('.png', '.pdf', '.svg')

# Setup plotting logic
vae_labels <- c("vae_0_two" = "k = 2 (0)",
                "vae_1_two" = "k = 2 (1)",
                "vae_0_three" = "k = 3 (0)",
                "vae_1_three" = "k = 3 (1)",
                "vae_2_three" = "k = 3 (2)")

vae_colors <- c("#c994c7",
                "#dd1c77",
                "#78c679",
                "#31a354",
                "#006837")

results_file <- file.path('results', 'gtex_vae_example_overrepresentation.tsv')
overrep_data_df <- (
    readr::read_tsv(results_file,
                    col_types = readr::cols(.default = readr::col_integer(),
                                            variable = readr::col_character(),
                                            full_feature = readr::col_character(),
                                            odds = readr::col_double(),
                                            pval = readr::col_double(),
                                            tailed = readr::col_character()))
    )

overrep_data_df$full_feature <- factor(overrep_data_df$full_feature,
                                       levels = c("vae_0_two",
                                                  "vae_1_two",
                                                  "vae_0_three",
                                                  "vae_1_three",
                                                  "vae_2_three"))

overrep_data_df$neg_log10_p <- -log10(overrep_data_df$pval)
head(overrep_data_df %>% dplyr::arrange(desc(neg_log10_p)))

color_logic <- overrep_data_df$neg_log10_p > 10

# Create Panel A for a Supplementary Figure
sup_panel_a_gg <- ggplot(overrep_data_df,
                         aes(x = odds,
                             y = neg_log10_p,
                             shape = tailed)) +
    geom_point(aes(color = as.factor(full_feature)),
                   size = 3) +
    scale_color_manual(name = "VAE Features",
                       values = vae_colors,
                       labels =  vae_labels) +
    scale_shape_manual(name = "Tail",
                       values = c("-", "+"),
                       labels = c("pos" = "Positive",
                                  "neg" = "Negative")) +
    geom_text_repel(data = subset(overrep_data_df, color_logic),
                    arrow = arrow(length = unit(0.01, "npc")),
                    segment.size = 0.3,
                    segment.alpha = 0.6,
                    size = 1.2,
                    fontface = "italic",
                    box.padding = 0.25,
                    point.padding = 0.15,
                    aes(x = odds,
                        y = neg_log10_p,
                        label = variable)) +
    xlab("Odds Ratio") +
    ylab("-log 10 p value") +
    theme_bw() +
    theme(axis.title = element_text(size = 7),
          axis.text.x = element_text(size = 6),
          axis.text.y = element_text(size = 6),
          legend.position = 'right',
          legend.title = element_text(size = 7),
          legend.text = element_text(size = 4.7),
          legend.margin = margin(0, 0, 0, 0),
          legend.box.margin = margin(-8, 0, 0, 0)) +
    guides(color = guide_legend(order = 1,
                                nrow = 5,
                                ncol = 1,
                                byrow = FALSE,
                                keywidth = 0.1,
                                keyheight = 0.1,
                                default.unit = "inch",
                                override.aes = list(size = 1.4,
                                                    alpha = 1)),
           shape = guide_legend(order = 2,
                                nrow = 2,
                                ncol = 1,
                                byrow = FALSE,
                                keywidth = 0.1,
                                keyheight = 0.1,
                                default.unit = "inch"))

sup_panel_a_gg

results_file <- file.path('results', 'gtex_vae_example_interpret_compression.tsv')
interpret_data_df <- (
    readr::read_tsv(results_file,
                    col_types = readr::cols(.default = readr::col_character(),
                                            raw_score = readr::col_double(),
                                            z_score = readr::col_double()))
    )

interpret_data_df$full_feature <- factor(interpret_data_df$full_feature,
                                  levels = c("vae_0_two", "vae_1_two", "vae_0_three",
                                             "vae_1_three", "vae_2_three"))

head(interpret_data_df)

combined_results_df <- overrep_data_df %>%
    dplyr::full_join(interpret_data_df,
                     by = c('variable', 'full_feature'))

head(combined_results_df)

color_logic <- (combined_results_df$z_score > 14 |
                combined_results_df$z_score < -20 |
                combined_results_df$neg_log10_p > 13)

sup_panel_b_gg <- ggplot(combined_results_df,
                         aes(x = z_score,
                             y = neg_log10_p,
                             shape = tailed)) +
    geom_point(aes(color = as.factor(full_feature)),
               size = 2) +
    scale_color_manual(name = "VAE Features",
                       values = vae_colors,
                       labels =  vae_labels) +
    scale_shape_manual(name = "Tail",
                       values = c("-", "+"),
                       labels = c("pos" = "Positive",
                                  "neg" = "Negative")) +
    geom_text_repel(data = subset(combined_results_df, color_logic),
                    arrow = arrow(length = unit(0.01, "npc")),
                    segment.size = 0.3,
                    segment.alpha = 0.6,
                    size = 1.2,
                    fontface = "italic",
                    box.padding = 0.25,
                    point.padding = 0.15,
                    aes(x = z_score,
                        y = neg_log10_p,
                        label = variable)) +
    xlab("BioBombe Z Score") +
    ylab("-log 10 p value (Overrepresentation)") +
    theme_bw() +
    theme(axis.title = element_text(size = 7),
          axis.text.x = element_text(size = 6),
          axis.text.y = element_text(size = 6),
          legend.position = 'right',
          legend.title = element_text(size = 7),
          legend.text = element_text(size = 4.7),
          legend.margin = margin(0, 0, 0, 0),
          legend.box.margin = margin(-8, 0, 0, 0)) +
    guides(color = guide_legend(order = 1,
                                nrow = 5,
                                ncol = 1,
                                byrow = FALSE,
                                keywidth = 0.1,
                                keyheight = 0.1,
                                default.unit = "inch",
                                override.aes = list(size = 1.4,
                                                    alpha = 1)),
           shape = guide_legend(order = 2,
                                nrow = 2,
                                ncol = 1,
                                byrow = FALSE,
                                keywidth = 0.1,
                                keyheight = 0.1,
                                default.unit = "inch"))

sup_panel_b_gg

# Load and process data
file <- file.path('results', 'latent_feature_enrichment_comparison_neutrophil_genesets.tsv')
geneset_weights_df <- (
    readr::read_tsv(file,
                    col_types = readr::cols(.default = readr::col_double(),
                                            model_type_z3 = readr::col_character(),
                                            variable = readr::col_character(),
                                            algorithm_z3 = readr::col_character(),
                                            model_type_z14 = readr::col_character(),
                                            algorithm_z14 = readr::col_character()))
    ) %>%
    dplyr::filter(feature_z3 == 0,
                  feature_z14 == 10)

head(geneset_weights_df, 3)

# Process plotting logic
color_logic <- ((geneset_weights_df$z_score_z3 < -9 | geneset_weights_df$z_score_z3 > 10) |
                (geneset_weights_df$z_score_z14 < -10 | geneset_weights_df$z_score_z14 > 10))

# Formula to plot linear model
formula <- y ~ x

sup_panel_c_gg <- ggplot(geneset_weights_df,
                     aes(x = z_score_z3, y = z_score_z14)) +
    geom_point(alpha = 0.5,
               size = 0.6,
               shape = 16,
               color = ifelse(color_logic, "red", "grey50")) +
    geom_smooth(method = "lm",
                formula = formula,
                se = TRUE,
                color = "grey20",
                alpha = 0.4,
                lwd = 0.3) +
    geom_hline(yintercept = 0,
               linetype = 'dashed',
               color = 'grey50',
               lwd = 0.3) +
    geom_vline(xintercept = 0,
               linetype = 'dashed',
               color = 'grey50',
               lwd = 0.3) +
    geom_text_repel(data = subset(geneset_weights_df, color_logic),
                    arrow = arrow(length = unit(0.01, "npc")),
                    segment.size = 0.3,
                    segment.alpha = 0.6,
                    size = 1.2,
                    fontface = "italic",
                    box.padding = 0.25,
                    point.padding = 0.15,
                    aes(x = z_score_z3,
                        y = z_score_z14,
                        label = variable)) +
    ggpmisc::stat_poly_eq(aes(label = paste(..rr.label..)),
                 label.x.npc = 0.8,
                 label.y.npc = 0.88,
                 formula = formula,
                 parse = TRUE,
                 size = 2,
                 na.rm = TRUE,
                 rr.digits = 1) +
    ggpmisc::stat_fit_glance(method = "lm",
                    geom = "text",
                    label.x.npc = 0.8,
                    label.y.npc = 0.97,
                    method.args = list(formula = formula),
                    size = 2,
                    aes(label = paste("p = ",
                                      signif(..p.value.., digits = 1),
                                      sep = ""))) +
    xlab("Z Score for VAE k = 3 (Feature 0)") +
    ylab("Z Score for VAE k = 14\n(Feature 10)") +
    theme_bw() +
    theme(axis.title = element_text(size = 7),
          axis.text.x = element_text(size = 6),
          axis.text.y = element_text(size = 6))

sup_panel_c_gg

# Load and Process Data
file <- file.path('results', 'latent_feature_enrichment_comparison_neutrophil_genes.tsv')
gene_weights_df <- (
    readr::read_tsv(file,
                    col_types = readr::cols(.default = readr::col_double(),
                                            classification = readr::col_character(),
                                            gene = readr::col_character(),
                                            gene_set = readr::col_character()))
    )

geneset_classes <- c('Neutrophils',
                     'Monocytes',
                     'Keratinocytes',
                     'Skeletal Muscle',
                     'Neurons',
                     'Other Geneset',
                     'No Geneset')

gene_weights_df$classification <- factor(gene_weights_df$classification,
                                         levels = geneset_classes,
                                         ordered = TRUE)

head(gene_weights_df, 3)

color_labels <- c("Neutrophils" = "#1b9e77",
                  "Keratinocytes" = "#6a3d9a",
                  "Neurons" = "#1f78b4",
                  "Skeletal Muscle" = "#ff7f00",
                  "Monocytes" = "#e7298a",
                  "Other Geneset" = "#CFDEDA",
                  "No Geneset" = "#F5B8D4")

other_points_logic <- gene_weights_df$classification %in% c('Other Geneset', 'No Geneset')

sup_panel_d_gg <- ggplot(gene_weights_df,
                     aes(x = vae_0_3,
                         y = vae_10)) +
    geom_point(data = subset(gene_weights_df, other_points_logic),
               aes(color = classification),
               shape = 16,
               size = 0.02,
               alpha = 0.4) +
    geom_point(data = subset(gene_weights_df, !other_points_logic),
               aes(color = classification),
               shape = 16,
               size = 0.2,
               alpha = 0.6) +
    geom_smooth(method = "lm",
                se = TRUE,
                color = "grey20",
                alpha = 0.4,
                lwd = 0.3) +
    geom_hline(yintercept = 0,
               linetype = 'dashed',
               color = 'grey50',
               lwd = 0.3) +
    geom_vline(xintercept = 0,
               linetype = 'dashed',
               color = 'grey50',
               lwd = 0.3) +
    stat_poly_eq(data = gene_weights_df,
                 aes(label = paste(..rr.label..)),
                 label.x.npc = 0.2,
                 label.y.npc = 0.58,
                 formula = formula,
                 parse = TRUE,
                 size = 2,
                 na.rm = TRUE,
                 rr.digits = 1) +
    stat_fit_glance(method = "lm",
                    geom = "text",
                    label.x.npc = 0.2,
                    label.y.npc = 0.67,
                    method.args = list(formula = formula),
                    size = 2,
                    aes(label = paste("p = ",
                                      signif(..p.value.., digits = 1),
                                      sep = ""))) +
    scale_color_manual(name = "Gene Set Class",
                       values = color_labels,
                       breaks = geneset_classes) +
    xlab("Z Score for VAE k = 3 (Feature 0)") +
    ylab("Z Score for VAE k = 14\n(Feature 10)") +
    theme_bw() +
    theme(axis.title = element_text(size = 7),
          axis.text.x = element_text(size = 6),
          axis.text.y = element_text(size = 6),
          legend.text = element_text(size = 4.7),
          legend.title = element_text(size = 6),
          legend.margin = margin(t = 0, r = 0, b = 0, l = 0),
          legend.box.margin = margin(t = -3, r = 0, b = -3, l = -3)) +
    guides(color = guide_legend(keywidth = 0.1,
                                keyheight = 0.1,
                                default.unit = "inch",
                                override.aes = list(size = 1.4,
                                                    alpha = 1)))

sup_panel_d_gg

legend_gg <- cowplot::get_legend(sup_panel_b_gg)

sup_panel_a_and_b_gg <- cowplot::plot_grid(
    sup_panel_a_gg +
        theme(legend.position = 'none'),
    sup_panel_b_gg +
        theme(legend.position = 'none'),
    nrow = 2,
    labels = c("a", "b"),
    rel_heights = c(1, 1)
)

sup_panel_a_and_b_gg <- cowplot::plot_grid(
    sup_panel_a_and_b_gg,
    legend_gg,
    rel_widths = c(1, 0.2),
    ncol = 2
)

sup_panel_c_and_d_gg <- cowplot::plot_grid(
    sup_panel_c_gg,
    sup_panel_d_gg,
    nrow = 2,
    labels = c("c", "d"),
    rel_widths = c(1, 1)
)

sup_gg <- cowplot::plot_grid(
    sup_panel_a_and_b_gg,
    sup_panel_c_and_d_gg,
    ncol = 2,
    labels = c("", ""),
    rel_widths = c(1, 0.8)
)

sup_gg

for(extension in fig_extensions) {
    gg_file <- paste0("gtex_biobombe_supplementary_figure", extension)
    gg_file <- file.path("figures", gg_file)
    cowplot::save_plot(filename = gg_file,
                       plot = sup_gg,
                       base_height = 130,
                       base_width = 170,
                       units = "mm",
                       dpi = 500)
}

cell_types <- c(
  "Neutrophil", "Monocyte"
)

line_plot <- list()
for (cell_type in cell_types) {
    file <- file.path("results", paste0("all_", tolower(cell_type),
                                        "_top_scores_and_separation.tsv"))
    final_results_df <- readr::read_tsv(file,
                                        col_types = readr::cols(
                                            .default = readr::col_integer(),
                                            algorithm = readr::col_character(),
                                            t_stat = readr::col_double(),
                                            t_p = readr::col_double(),
                                            neg_log_p = readr::col_double(),
                                            variable = readr::col_character(),
                                            model_type = readr::col_character(),
                                            value = readr::col_double(),
                                            z_score = readr::col_double(),
                                            abs_z_score = readr::col_double()))
    final_results_df$algorithm <-
      dplyr::recode(final_results_df$algorithm,
                    "pca" = "PCA", "ica" = "ICA", "nmf" = "NMF", "dae" = "DAE",
                    "vae" = "VAE")

    # Create factors for plotting
    final_results_df$z <-
      factor(final_results_df$z,
             levels =
               sort(as.numeric(paste(unique(final_results_df$z))))
      )

    final_results_df$algorithm <-
      factor(final_results_df$algorithm,
             levels = c("PCA", "ICA", "NMF", "DAE", "VAE"))

    final_results_df <- final_results_df %>% dplyr::arrange(z)

    # Generate plot title
    if (cell_type == "Neutrophil") {
        gse <- "GSE103706"
    } else {
        gse <- "GSE24759"
    }
    plot_title <- paste(cell_type, "-", gse)

    line_plot[[cell_type]] <- # Plot and save to file
      ggplot(final_results_df,
             aes(x = z,
                 y = neg_log_p,
                 color = algorithm,
                 group = algorithm)) +
      geom_point(size = 0.1) +
      geom_smooth(lwd = 0.2,
                  formula = y ~ x,
                  method = "loess",
                  alpha = 0.2,
                  aes(fill = algorithm)) +
      scale_color_manual(name = "Algorithm",
                         values = c("#e41a1c",
                                    "#377eb8",
                                    "#4daf4a",
                                    "#984ea3",
                                    "#ff7f00"),
                         labels = c("pca" = "PCA",
                                    "ica" = "ICA",
                                    "nmf" = "NMF",
                                    "dae" = "DAE",
                                    "vae" = "VAE")) +
      scale_fill_manual(name = "Algorithm",
                        values = c("#e41a1c",
                                   "#377eb8",
                                   "#4daf4a",
                                   "#984ea3",
                                   "#ff7f00"),
                        labels = c("pca" = "PCA",
                                   "ica" = "ICA",
                                   "nmf" = "NMF",
                                   "dae" = "DAE",
                                   "vae" = "VAE")) +
      theme_bw() +
      ggtitle(plot_title) +
      ylab("-log 10 P") +
      xlab("k Dimensions") +
      theme(axis.title.x = element_text(size = 7),
            axis.title.y = element_text(size = 7),
            axis.text.x = element_text(angle = 90,
                                     size = 5),
            axis.text.y = element_text(size = 6),
            plot.title = element_text(hjust = 0.5,
                                    size = 8),
            legend.text = element_text(size = 6),
            legend.title = element_text(size = 7),
            legend.key.size = unit(0.7, "lines"))
}

# Plot
line_legend <- cowplot::get_legend(line_plot[['Neutrophil']])
sup_fig_2_panel_a_gg <- cowplot::plot_grid(
    line_plot[['Neutrophil']] + theme(legend.position = "none"),
    line_plot[['Monocyte']] + theme(legend.position = "none"),
    labels = c("a", ""),
    ncol = 2
)

sup_fig_2_panel_a_gg <- cowplot::plot_grid(
    sup_fig_2_panel_a_gg,
    line_legend,
    rel_widths = c(1, 0.15),
    ncol = 2
)

sup_fig_2_panel_a_gg

myPalette <- colorRampPalette(rev(c("#43b8d8",
                                    "#9e5eed",
                                    "#ef07c4",
                                    "#ef0707")))

career_path_plot <- list()
for (cell_type in cell_types) {
    file <- file.path("results", paste0("all_", tolower(cell_type),
                                      "_top_scores_and_separation.tsv"))
    final_results_df <- readr::read_tsv(file,
                                        col_types = readr::cols(
                                            .default = readr::col_integer(),
                                            algorithm = readr::col_character(),
                                            t_stat = readr::col_double(),
                                            t_p = readr::col_double(),
                                            neg_log_p = readr::col_double(),
                                            variable = readr::col_character(),
                                            model_type = readr::col_character(),
                                            value = readr::col_double(),
                                            z_score = readr::col_double(),
                                            abs_z_score = readr::col_double()))
    final_results_df$algorithm <-
    dplyr::recode(final_results_df$algorithm,
                  "pca" = "PCA", "ica" = "ICA", "nmf" = "NMF", "dae" = "DAE",
                  "vae" = "VAE")

    # Create factors for plotting
    final_results_df$z <-
    factor(final_results_df$z,
           levels =
             sort(as.numeric(paste(unique(final_results_df$z))))
    )

    final_results_df$algorithm <-
    factor(final_results_df$algorithm,
           levels = c("PCA", "ICA", "NMF", "DAE", "VAE"))

    final_results_df <- final_results_df %>% dplyr::arrange(z)

    career_path_plot[[cell_type]] <-
    ggplot(final_results_df,
                          aes(y = neg_log_p,
                              x = abs_z_score,
                              group = algorithm)) +
    geom_point(size = 0.1, alpha = 0.9) +
    geom_path(aes(color = z_dim),
              lwd = 0.2) +
    facet_wrap(~algorithm, ncol = 5) +
    scale_color_gradientn(name = "k Dimension",
                          colours = myPalette(300),
                          values = scales::rescale(c(200, 125, 25, 10, 0)),
                          limits = c(0, 200)) +
    theme_bw() +
    ylab("-log10 P") +
    xlab("BioBombe Score") +
    theme(strip.background = element_rect(colour = "black",
                                          fill = "#fdfff4"),
          strip.text.x = element_text(size = 5,
                                      margin = margin(t = 2,
                                                      b = 1,
                                                      l = 0,
                                                      r = 0)),
          axis.title.x = element_text(size = 7),
          axis.title.y = element_text(size = 7),
          axis.text.x = element_text(angle = 90,
                                     size = 5),
          axis.text.y = element_text(size = 6),
          legend.text = element_text(size = 6),
          legend.title = element_text(size = 7),
          legend.key.size = unit(0.7, "lines"))
}

career_legend <- cowplot::get_legend(career_path_plot[['Neutrophil']])

sup_fig_2_panel_b_gg <- cowplot::plot_grid(
    career_path_plot[['Neutrophil']] + theme(legend.position = "none"),
    career_path_plot[['Monocyte']] + theme(legend.position = "none"),
    labels = c("b", ""),
    ncol = 2
)

sup_fig_2_panel_b_gg <- cowplot::plot_grid(
    sup_fig_2_panel_b_gg,
    career_legend,
    rel_widths = c(1, 0.15),
    ncol = 2
)

sup_fig_2_panel_b_gg

sup_fig_2_panel_a_and_b_gg <- cowplot::plot_grid(
    sup_fig_2_panel_a_gg,
    sup_fig_2_panel_b_gg,
    nrow = 2,
    rel_heights = c(1.1, 0.9)
)

sup_fig_2_panel_a_and_b_gg

for(extension in fig_extensions) {
    gg_file <- paste0("gtex_biobombe_supplementary_validation_figure", extension)
    gg_file <- file.path("figures", gg_file)
    cowplot::save_plot(filename = gg_file,
                       plot = sup_fig_2_panel_a_and_b_gg,
                       base_height = 110,
                       base_width = 170,
                       units = "mm",
                       dpi = 500)
}

# Load and process data
results_file <- file.path('results', 'gtex_vae_example_interpret_compression.tsv')
interpret_data_df <- (
    readr::read_tsv(results_file,
                    col_types = readr::cols(.default = readr::col_character(),
                                            raw_score = readr::col_double(),
                                            z_score = readr::col_double()))
    )

interpret_data_df$full_feature <- factor(interpret_data_df$full_feature,
                                  levels = c("vae_0_two", "vae_1_two", "vae_0_three",
                                             "vae_1_three", "vae_2_three"))

# Setup plotting logic
vae_labels <- c("vae_0_two" = "k = 2 (0)",
                "vae_1_two" = "k = 2 (1)",
                "vae_0_three" = "k = 3 (0)",
                "vae_1_three" = "k = 3 (1)",
                "vae_2_three" = "k = 3 (2)")

vae_colors <- c("#c994c7", "#dd1c77", "#78c679", "#31a354", "#006837")

color_logic <- (interpret_data_df$z_score > 13 |
                interpret_data_df$z_score < -18 |
                interpret_data_df$raw_score < -22)

# Plot
neutrophil_points_df <- subset(interpret_data_df, color_logic)
num_points <- dim(neutrophil_points_df)[1]
neutrophil_colors <- rep("black", num_points)
neutrophil_colors[neutrophil_points_df$variable == 'Neutrophils_HPCA_2'] <- "red"

panel_a_gg <- ggplot(interpret_data_df,
                     aes(x = raw_score,
                         y = z_score)) +
    geom_point(aes(color = full_feature),
               size = 0.14,
               alpha = 0.65) +
    scale_color_manual(name = "",
                       values = vae_colors,
                       labels =  vae_labels) +
    geom_text_repel(data = neutrophil_points_df,
                    arrow = arrow(length = unit(0.01, "npc")),
                    color = neutrophil_colors,
                    segment.size = 0.3,
                    segment.alpha = 0.6,
                    size = 1.5,
                    fontface = "italic",
                    box.padding = 0.47,
                    point.padding = 0.23,
                    aes(x = raw_score,
                        y = z_score,
                        label = variable)) +
    xlab("BioBombe Raw Score") +
    ylab("BioBombe Z Score") +
    theme_bw() +
    theme(axis.title = element_text(size = 7),
          axis.text.x = element_text(size = 6),
          axis.text.y = element_text(size = 6),
          legend.position = 'bottom',
          legend.text = element_text(size = 4.7),
          legend.margin = margin(0, 0, 0, 0),
          legend.box.margin = margin(-8, 0, 0, 0)) +
    guides(color = guide_legend(nrow = 2,
                                ncol = 3,
                                byrow = FALSE,
                                keywidth = 0.1,
                                keyheight = 0.1,
                                default.unit = "inch",
                                override.aes = list(size = 1.4,
                                                    alpha = 1)))

panel_a_gg

# Load and process data
file <- file.path('results', 'gtex_vae_example_differentiating_features.tsv')
feature_info_df <- readr::read_tsv(file,
                                   col_types = readr::cols(.default = readr::col_double(),
                                                           variable = readr::col_character()))

# Setup plotting logic
color_logic = feature_info_df$abs_diff > 3.5 | feature_info_df$two > 13  | feature_info_df$three > 13

# Plot
monocyte_points_df <- subset(feature_info_df, color_logic)
num_points <- dim(monocyte_points_df)[1]
monocyte_colors <- rep("black", num_points)
monocyte_colors[monocyte_points_df$variable == 'Monocytes_FANTOM_2'] <- "red"

panel_b_gg <- ggplot(feature_info_df, aes(x = three, y = two)) +
    geom_point(alpha = 0.5,
               size = 0.6,
               shape = 16,
               color = ifelse(color_logic, "red", "grey50")) +
    geom_abline(intercept = 0, slope = 1, linetype = 'dashed') +
    geom_text_repel(data = monocyte_points_df,
                    arrow = arrow(length = unit(0.01, "npc")),
                    color = monocyte_colors,
                    segment.size = 0.3,
                    segment.alpha = 0.6,
                    size = 1.5,
                    fontface = "italic",
                    box.padding = 0.25,
                    point.padding = 0.15,
                    aes(x = three,
                        y = two,
                        label = variable)) +
    xlab("Mean BioBombe Z Score (VAE k = 3)") +
    ylab("Mean BioBombe Z Score (VAE k = 2)") +
    theme_bw() +
    theme(axis.title = element_text(size = 7),
          axis.text.x = element_text(size = 6),
          axis.text.y = element_text(size = 6))

panel_b_gg

gene_set_dir <- file.path("..", "6.biobombe-projection",
                          "results", "gtex",
                          "gpxcell", "signal")
metaedge <- "GpXCELL"
dataset <- "GTEX"

# Compile all results (use this for plotting later)
biobombe_results_df <- get_biobombe_results(gene_set_dir = gene_set_dir)

line_plot_theme <-
    theme(strip.background = element_rect(colour = "black",
                                          fill = "#fdfff4"),
          strip.text = element_text(size = 6),
          axis.title = element_text(size = 7),
          axis.title.x = element_text(margin = margin(t = 0.1,
                                                      r = 0,
                                                      b = 0,
                                                      l = 0,
                                                      unit = 'cm')),
          axis.text.x = element_text(size = 5),
          axis.text.y = element_text(size = 6),
          legend.text = element_text(size = 4.7),
          legend.title = element_text(size = 6),
          legend.margin = margin(t = 0,
                                 r = 0,
                                 b = 0,
                                 l = 0),
          legend.box.margin = margin(t = -3,
                                     r = 0,
                                     b = -3,
                                     l = -3))

panel_c_gg <- plot_gene_set(gene_set = "Neutrophils_HPCA_2",
                            full_results_df = biobombe_results_df,
                            metaedge = metaedge,
                            dataset = dataset,
                            show_plot = FALSE,
                            shuffled = FALSE,
                            return_top = FALSE,
                            return_plot = TRUE)

panel_c_gg <- panel_c_gg +
    line_plot_theme +
    ylab("BioBombe Score") +
    theme(title = element_text(size = 6),
          axis.title.y = element_text(size = 6),
          axis.title.x = element_text(size = 6))

panel_c_gg

panel_d_gg <- plot_gene_set(gene_set = "Monocytes_FANTOM_2",
                            full_results_df = biobombe_results_df,
                            metaedge = metaedge,
                            dataset = dataset,
                            show_plot = FALSE,
                            shuffled = FALSE,
                            return_top = FALSE,
                            return_plot = TRUE)

panel_d_gg <- panel_d_gg +
    line_plot_theme +
    ylab("BioBombe Score") +
    theme(title = element_text(size = 6),
          axis.title.y = element_text(size = 6),
          axis.title.x = element_text(size = 6))

panel_d_gg

# Load and process data
file <- file.path('results', 'neutrophil_data_biobombe_results.tsv')
full_neutrophil_results_df <-
    readr::read_tsv(file,
                    col_types = readr::cols(.default = readr::col_double(),
                                            full_id = readr::col_character(),
                                            cell_line = readr::col_character(),
                                            treatment = readr::col_character(),
                                            day = readr::col_character()))

full_neutrophil_results_df <-
    reshape2::melt(full_neutrophil_results_df,
                   id.vars = c('full_id', 'cell_line', 'treatment', 'day'),
                   variable.vars = c('vae_10', 'vae_0'),
                   variable.name = 'feature',
                   value.name = 'score')

full_neutrophil_results_df$feature <-
    dplyr::recode_factor(full_neutrophil_results_df$feature,
                         'vae_0' = 'VAE k = 3 (Feature 0)',
                         'vae_10' = 'VAE k = 14 (Feature 10)',
                         .ordered = TRUE)

head(full_neutrophil_results_df, 3)

panel_e_gg <- ggplot(full_neutrophil_results_df,
                     aes(x = cell_line,
                         y = score)) +
    geom_jitter(aes(color = treatment),
                width = 0.1,
                height = 0,
                size = 0.8,
                alpha = 0.8) +
    coord_flip() +
    facet_wrap(~feature,
               scales = "free") +
    scale_color_manual(name = "",
                       values = c("DMSO" = "#c40000",
                                  "DMSO+Nutridoma" = "#fca82a",
                                  "Not Differentiated" = "#695eff")) +
    xlab('') +
    ylab('BioBombe Score') +
    ggtitle("GSE103706") +
    theme_bw() +
    theme(plot.title = element_text(hjust = 0.5,
                                    size = 8),
          strip.background = element_rect(colour = "black",
                                          fill = "#fdfff4"),
          strip.text = element_text(size = 4.7),
          axis.title = element_text(size = 7),
          axis.text.x = element_text(size = 6),
          axis.text.y = element_text(size = 6),
          legend.position = 'bottom',
          legend.text = element_text(size = 4.7),
          legend.margin = margin(0, 0, 0, 0),
          legend.box.margin = margin(-8, 0, 0, 0)) +
    guides(color = guide_legend(nrow = 1,
                                ncol = 5,
                                byrow = FALSE,
                                keywidth = 0.1,
                                keyheight = 0.1,
                                default.unit = "inch",
                                override.aes = list(size = 1.4,
                                                    alpha = 1)))

panel_e_gg

# Load and process results
file <- file.path('results', 'hematopoietic_data_biobombe_results.tsv')

full_heme_results_df <-
    readr::read_tsv(file,
                    col_types = readr::cols(.default = readr::col_double(),
                                            cell_type = readr::col_character(),
                                            replicate = readr::col_character(),
                                            cell = readr::col_character(),
                                            cell_class = readr::col_character()))

full_heme_results_df <-
    reshape2::melt(full_heme_results_df,
                   id.vars = c('cell_type', 'replicate', 'cell', 'cell_class'),
                   variable.vars = c('vae_2', 'nmf_6'),
                   variable.name = 'feature',
                   value.name = 'score')

full_heme_results_df$feature <-
    dplyr::recode_factor(full_heme_results_df$feature,
                         'vae_2' = 'VAE k = 3 (Feature 2)',
                         'nmf_6' = 'NMF k = 200 (Feature 6)',
                         .ordered = TRUE)

head(full_heme_results_df, 3)

# Plot
n_colors <- length(unique(full_heme_results_df$cell_type))

y_axis_colors <- rep("black", n_colors)
y_axis_colors[unique(full_heme_results_df$cell_type) == 'MONO2'] <- "red"

panel_f_gg <- ggplot(full_heme_results_df,
                     aes(x = cell_type,
                         y = score)) +
    geom_boxplot(aes(color = cell_type),
                 outlier.alpha = 0,
                 lwd = 0.2) +
    geom_jitter(aes(color = cell_type),
                width = 0.1,
                size = 0.2,
                alpha = 0.8) +
    facet_wrap(~ feature, scales = "free", ncol = 2) +
    coord_flip() +
    scale_color_manual(values = colorRampPalette(RColorBrewer::brewer.pal(8, "Dark2"))(n_colors)) +
    xlab('') +
    ylab('BioBombe Score') +
    ggtitle("GSE24759") +
    theme_bw() +
    theme(plot.title = element_text(hjust = 0.5,
                                    size = 8),
          strip.background = element_rect(colour = "black",
                                          fill = "#fdfff4"),
          strip.text = element_text(size = 4.7),
          axis.title = element_text(size = 7),
          axis.text.x = element_text(size = 6),
          axis.text.y = element_text(size = 3.5,
                                     color = y_axis_colors),
          legend.position = 'none')

panel_f_gg

c_and_d_legend_gg <- cowplot::get_legend(panel_c_gg)
c_and_d_gg <- cowplot::plot_grid(
    panel_c_gg + theme(legend.position = "none"),
    panel_d_gg + theme(legend.position = "none"),
    nrow = 2,
    labels = c("c", "d")
)

c_and_d_gg <- cowplot::plot_grid(
    c_and_d_gg,
    c_and_d_legend_gg,
    rel_widths = c(1, 0.17),
    ncol = 2
)

c_and_d_gg

a_b_c_and_d_gg <- cowplot::plot_grid(
    panel_a_gg,
    panel_b_gg,
    c_and_d_gg,
    ncol = 3,
    labels = c("a", "b", ""),
    rel_widths = c(0.95, 0.95, 1)
)

a_b_c_and_d_gg

e_and_f_gg <- cowplot::plot_grid(
    panel_e_gg,
    panel_f_gg,
    ncol = 2,
    labels = c("e", "f"),
    rel_widths = c(0.7, 1)
)

e_and_f_gg

full_gg <- cowplot::plot_grid(
    a_b_c_and_d_gg,
    e_and_f_gg,
    nrow = 2,
    rel_heights = c(1, 1.1)
)

full_gg

for(extension in fig_extensions) {
    gg_file <- paste0("gtex_biobombe_main_figure", extension)
    gg_file <- file.path("figures", gg_file)
    cowplot::save_plot(filename = gg_file,
                       plot = full_gg,
                       base_height = 170,
                       base_width = 170,
                       units = "mm",
                       dpi = 500)
}


library(xml2)
library(forcats)
library(viridis)
library(tmaptools)
library(sf)
library(tidyverse)
library(geom_raster)
library(sf)
library(ggthemes)
G_PROJ4DEF <- '+proj=lcc +lat_1=49 +lat_2=77 +lat_0=49 +lon_0=-95 +x_0=0 +y_0=0 +ellps=GRS80 +datum=NAD83 +units=m +no_defs'
G_CRS_CODE <- 'EPSG:3978'

#crs_canada <- "+proj=lcc +lat_1=49 +lat_2=77 +lon_0=-91.52 +x_0=0 +y_0=0 +datum=NAD83 +units=m +no_defs"
G_CRS_WGS <- "+proj=longlat +datum=WGS84"

#getwd()

##################################333
# Geocode with Open Streeat maps
# but only if not in spreadsheet
geocode_OSM_with_cache <- function(vec, file_loc = file.path("OSM_geocoded_strings.tsv")){
  cache <- read_tsv(file_loc)

  to_look_up <- vec[!vec %in% cache$query]

  new_loc <- tryCatch({
    geocode_OSM(to_look_up, as.data.frame = T)
  }, error = function(e) {
    cache %>% filter( 1 == 0 )
  }, finally = {
    print("Done")
  })

  new_loc <-
    new_loc %>%
    mutate(human_check = "none")

  if (!is.null(new_loc))
    cache <- bind_rows(cache, new_loc) %>% distinct()

  cache %>% write_tsv(file_loc)
  cache %>% filter(query %in% vec)
}

#########################################
#
# Read data from VIRI Health websit
#
read_viri_health_data <- function(webpage_url = "https://virihealth.com/", crs_out = G_CRS_WGS){
  #########################
  # Dont do this all the time
  webpage <- xml2::read_html(webpage_url)

  ret_val <- list()
  ret_val[["totals"]] <- rvest::html_table(webpage)[[1]] %>%
    tibble::as_tibble(.name_repair = "unique") # repair the repeated columns

  ret_val[["prov"]] <- rvest::html_table(webpage)[[2]] %>%
    tibble::as_tibble(.name_repair = "unique") # repair the repeated columns

  ret_val[["city"]] <- rvest::html_table(webpage)[[3]] %>%
    tibble::as_tibble(.name_repair = "unique") # repair the repeated columns

  ret_val[["sex"]] <- rvest::html_table(webpage)[[4]] %>%
    tibble::as_tibble(.name_repair = "unique") # repair the repeated columns

  ret_val[["hospital"]] <- rvest::html_table(webpage)[[5]] %>%
    tibble::as_tibble(.name_repair = "unique") # repair the repeated columns

  ret_val[["tests"]] <- rvest::html_table(webpage)[[6]] %>%
    tibble::as_tibble(.name_repair = "unique")# repair the repeated columns

  ret_val[["prov_recovered"]] <- rvest::html_table(webpage)[[7]] %>%
    tibble::as_tibble(.name_repair = "unique")

  ret_val[["deaths"]] <- rvest::html_table(webpage)[[8]] %>%
    tibble::as_tibble(.name_repair = "unique")

  ret_val[["cases"]] <- rvest::html_table(webpage)[[9]] %>%
    tibble::as_tibble(.name_repair = "unique")

  ret_val[["cases"]] <- ret_val[["cases"]] %>%
    mutate(to_geo = tolower(paste(City, Prov, "Canada",sep = ", ")) )

  for_geo <- ret_val[["cases"]] %>% pull(to_geo) %>% unique()
  cases_cols <- ret_val[["cases"]] %>% colnames()

  geo_loc <- geocode_OSM_with_cache(for_geo)

  ret_val[["cases"]] <- left_join(ret_val[["cases"]], geo_loc, by = c("to_geo" = "query"))

  ret_val[["cases"]] <-
    ret_val[["cases"]] %>%
    mutate(to_geo = if_else(is.na(lat),    tolower(paste( Prov, "Canada",sep = ", ")), to_geo ))

  ctry2 <- ret_val[["cases"]] %>% filter(is.na(lat))
  ctry1 <- ret_val[["cases"]] %>% filter(!is.na(lat))
  geo_loc <- geocode_OSM_with_cache(ctry2$to_geo %>% unique())

  ctry2 <- ctry2 %>% select(cases_cols)
  ctry2 <- left_join(ctry2, geo_loc, by = c("to_geo" = "query"))

  ret_val[["cases"]] <- bind_rows(ctry2, ctry1)

  ret_val[["cases"]] <-
    ret_val[["cases"]] %>%
    replace_na(list(lat = 75, lon = -40)) %>%
    st_as_sf(coords = c("lon", "lat"), crs = G_CRS_WGS) %>%
    st_transform(crs = crs_out)

  return(ret_val)
}

############################33
# TODO ::
Plot_provincial_choropleth(data){

}

 ############3 Some bugs below ##################
data <- NULL
data <- read_viri_health_data()

canada_HR_shp <- read_sf(file.path("HR000b11a_e_Oct2013_simp.geojson")) %>%
  st_transform(canada_shp, crs = G_PROJ4DEF)

canada_HR_shp %>%
  ggplot() +
  geom_sf() +
  theme_map()

canada_prov_shp <- read_sf(file.path("canada_pt_sim.geojson")) %>%
  st_transform(canada_shp, crs = G_PROJ4DEF)

canada_prov_shp %>%
  ggplot() +
  geom_sf(alpha = 0, size = 1.25, color = "black") +
  theme_map()

data$prov

points<-
data$cases %>%
  st_transform(canada_shp, crs = G_PROJ4DEF)
  # st_coordinates(data$cases) %>%
  # as_tibble() %>%
  # bind_cols(., data$cases)
  #

data$cases %>% group_by(Y) %>% summarise(n = n()) %>% view()

p <-
  canada_shp %>%
  ggplot() +
  geom_sf() +
  theme_map()

p +
  geom_sf(data = points, mapping = aes()) +
  scale_color_viridis() +
  scale_fill_viridis()

data$cases %>% view()
fn <- paste0("virihealth_cases_", Sys.Date(), ".tsv")
ret_val[["cases"]] %>% write_tsv(fn)

fn <- paste0("virihealth_by_city_", Sys.Date(), ".tsv")
ret_val[["cases"]] %>% group_by(City, Prov, lat, lon,  lat_min, lat_max, lon_min, lon_max) %>% summarise(N = n()) %>%
  write_tsv(fn)

fn <- paste0("virihealth_by_prov_", Sys.Date(), ".tsv")
ret_val[["cases"]] %>% group_by(Prov) %>% summarise(N = n()) %>%
  write_tsv(fn)

lat_lng <- st_coordinates(data$cases)
rbind(lat_lng, data$cases)

data$tests %>%
  mutate(Tests = as.integer(sub(",", "",Tests)),  Positive= as.integer(sub(",", "",Positive))) %>%
  mutate(Negative = Tests - Positive) %>%
  select(Prov, Negative, Positive, Tests ) %>%
  mutate(Per = 100*Positive/Tests) %>%
  filter(!Prov %in% c("TOT","RC") ) %>%
  pivot_longer(cols = c("Negative", "Positive")) %>%
  mutate(Prov = paste0(Prov, "\n Tests =", Tests, "\nPositive=", round(Per, 1), "%")) %>%
  mutate(Prov = fct_reorder(Prov, 1/Tests)) %>%
  ggplot(aes(x=sqrt(Tests)/2, y = value, fill = name, width = sqrt(Tests))) +
  geom_bar(position="fill", stat="identity") +
  facet_wrap(vars(Prov)) +
  #facet_grid(side1 ~ side2) +
  coord_polar("y") +
  labs(title = "COVID-19 tests performed by provinces.", fill = "COVOD-19 test results." ) +
  theme_void() +
  theme(
        panel.border = element_rect(linetype = "dashed", fill = NA)
        )


# Code Source: https://en.wikibooks.org/wiki/Data_Mining_Algorithms_In_R/Sequence_Mining/SPADE

# 最小支持度：篩選出至少40%的人共有的樣式
minSupport <- 0.4

# ------------------------
# 套件安裝

if(require("arules")){
  print("arules is loaded correctly")
} else {
  print("trying to install arules")
  install.packages("arules")
  if(require(arules)){
    print("arules installed and loaded")
  } else {
    stop("could not install arules")
  }
}

if(require("arulesSequences")){
  print("arulesSequences is loaded correctly")
} else {
  print("trying to install arulesSequences")
  install.packages("arulesSequences")
  if(require(arules)){
    print("arulesSequences installed and loaded")
  } else {
    stop("could not install arulesSequences")
  }
}

if(require("stringr")){
  print("stringr is loaded correctly")
} else {
  print("trying to install stringr")
  install.packages("stringr")
  if(require(stringr)){
    print("stringr installed and loaded")
  } else {
    stop("could not install stringr")
  }
}

# 套件載入
library(Matrix)
library(arules)
library(arulesSequences)
library(stringr)

# 定義函式trim()
trim <- function (x) gsub("^\\s+|\\s+$", "", x)

# --------------------------

df = read.csv(choose.files(default = "input.csv", caption = "Please select an input CSV file"), fileEncoding = "UTF-8")
#df = read.csv("data.csv", fileEncoding = "UTF-8") # 測試用

# 避免欄位變成charactor或factor，要轉換成string
df <- data.frame(lapply(df, as.character), stringsAsFactors=FALSE)

# 取得欄位名字
col.names <- colnames(df)

# 排序
df<-df[order(df[col.names[2]], decreasing = FALSE),]
df<-df[order(df[col.names[1]], decreasing = FALSE),]

# --------------------------

df3 <- data.frame(user_id = c(), seq_id=c(), events=c(), stringsAsFactors=FALSE)
colnames(df3) <- col.names

lastUserId <- 0
lastSeqId <- 0
lastIndex <- 0
for(i in 1:nrow(df)) {
  userId <- df[i,col.names[1]]
  seqId <- df[i,col.names[2]]
  if (i == 1) {

    df3 <- rbind(df3, df[i,])
    lastIndex <- i
    lastUserId <- userId
    lastSeqId <- seqId
  } else {
    if (lastUserId == userId && lastSeqId == seqId) {
      events1 <- df3[nrow(df3), col.names[3]]
      events2 <- df[i, col.names[3]]
      df3[nrow(df3), col.names[3]] <- paste(events1, events2)
    } else {
      df3 <- rbind(df3, df[i,])
      lastIndex <- i
      lastUserId <- userId
      lastSeqId <- seqId
    }
  }
}

df <- df3

# --------------------------

# 將分號;取代為空格
df[col.names[3]] <- sapply(df[col.names[3]], function(x) {
  gsub(";", " ", x)
})

# 計算事件的數量
df$Event_count <- sapply(df[,col.names[3]], function(x) {
  length(unlist(strsplit(as.character(trim(x)), "\\W+")))
})

df2<-data.frame("score"=df[col.names[1]],"sequence_length"=df[col.names[2]],"support"=df["Event_count"],"sequence"=df[col.names[3]], stringsAsFactors=FALSE)

tmp.txt <- "tmp.txt"
write.table(df2, file=tmp.txt, row.names=FALSE, col.names=FALSE, sep=" ", quote=FALSE)

# --------------------------

x <- read_baskets(tmp.txt, info = c("sequenceID","eventID","SIZE"))
s1 <- cspade(x, parameter = list(support = minSupport), control = list(verbose = TRUE))

# -------------

s2<-as(s1, "data.frame")
s2["sequence_length"]<-c(str_count(array(unlist(s2["sequence"])), "\\},\\{")+1)
s2["score"]<-c(s2["sequence_length"]*s2["support"])
s2<-s2[order(s2["score"], decreasing = TRUE),]
s3<-data.frame("score"=s2["score"],"sequence_length"=s2["sequence_length"],"support"=s2["support"],"sequence"=s2["sequence"], stringsAsFactors=FALSE)
s3$score <- sapply(s3$score, function(x) {
  round(x, 3)
})
s3$support <- sapply(s3$support, function(x) {
  round(x, 3)
})

# 寫入檔案
write.table(s3, file=choose.files(default = paste0("output-",format(Sys.time(), "%m%d-%H%M"),".csv"), caption = "Please specify the output CSV file path"), row.names=FALSE, sep=",")

# -------------
file.remove(tmp.txt)


context("test eliminate constraint")
test_that("with degenerate velocity constraint --> no velocity constraint", {
    fmax_info <- maximize_wrench(H_matrix, bounds_tuple_of_numeric, direction = c(1,
        0, 0, 0))
    st_constr_str <- force_cos_ramp_constraint(H_matrix, bounds_tuple_of_numeric,
        fmax_info$output_vector_per_task[[1]], 1, 1, n_task_values = 3, eliminate = FALSE)
    res <- st_constr_str$nonredundant_constr %>% eliminate_redundant
    removed_rows <- attr(res, "redundancy_info")$redundant
    degenerate_case_redundant_rows <- c(9, 10, 11, 12, 20, 21, 22, 31, 32, 33, 34,
        35, 36, 37, 39, 41, 44, 53, 54, 55, 56, 64, 65, 66, 67, 68, 69, 70, 71, 72,
        73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91,
        92, 93, 94)
    expect_equal(removed_rows, degenerate_case_redundant_rows)

})

test_that("with 0.5 velocity constraint", {
    fmax_info <- maximize_wrench(H_matrix, bounds_tuple_of_numeric, direction = c(1,
        0, 0, 0))
    st_constr_str <- force_cos_ramp_constraint(H_matrix, bounds_tuple_of_numeric,
        fmax_info$output_vector_per_task[[1]], 0.5, 0.5, n_task_values = 3, eliminate = FALSE)
    res <- st_constr_str$nonredundant_constr %>% eliminate_redundant

    expected_n3_medium_constr_redundant_rows <- c(5, 6, 7, 8, 12, 14, 15, 16, 17,
        18, 19, 20, 21, 22, 27, 28, 29, 30, 32, 34, 36, 37, 38, 39, 40, 41, 42, 43,
        44, 49, 50, 51, 52, 54, 56, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69,
        70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88,
        89, 90, 91, 92, 93, 94)

    expect_equal(removed_rows, expected_n3_medium_constr_redundant_rows)
})

test_that("with very aggressive velocity constraint", {
    fmax_info <- maximize_wrench(H_matrix, bounds_tuple_of_numeric, direction = c(1,
        0, 0, 0))
    st_constr_str <- force_cos_ramp_constraint(H_matrix, bounds_tuple_of_numeric,
        fmax_info$output_vector_per_task[[1]], 0.001, 0.001, n_task_values = 3, eliminate = FALSE)
    res <- st_constr_str$nonredundant_constr %>% eliminate_redundant2
    removed_rows <- extract_redundant_rows(res)

    expected_n3_no_space_redundant_rows <- c(5, 6, 7, 8, 12, 14, 15, 16, 17, 18,
        19, 20, 21, 22, 27, 28, 29, 30, 32, 34, 36, 37, 38, 39, 40, 41, 42, 43, 44,
        49, 50, 51, 52, 54, 56, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70,
        71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89,
        90, 91, 92, 93, 94)
    expect_equal(removed_rows, expected_n3_no_space_redundant_rows)
})

test_that("same result as original hitandrun::eliminateRedundant", {
    fmax_info <- maximize_wrench(H_matrix, bounds_tuple_of_numeric, direction = c(1,
        0, 0, 0))
    st_constr_str <- force_cos_ramp_constraint(H_matrix, bounds_tuple_of_numeric,
        fmax_info$output_vector_per_task[[1]], 0.001, 0.001, n_task_values = 3, eliminate = FALSE)
    res_2 <- st_constr_str$nonredundant_constr %>% eliminate_redundant2
    res_original <- st_constr_str$nonredundant_constr %>% eliminate_redundant
    removed_rows <- extract_redundant_rows(res)

    expect_equal(res_2$constr%>%unname, res_original$constr%>%unname)
    expect_equal(res_2$rhs%>%unname, res_original$rhs%>%unname)

    expected_n3_no_space_redundant_rows <- c(5, 6, 7, 8, 12, 14, 15, 16, 17, 18,
        19, 20, 21, 22, 27, 28, 29, 30, 32, 34, 36, 37, 38, 39, 40, 41, 42, 43, 44,
        49, 50, 51, 52, 54, 56, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70,
        71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89,
        90, 91, 92, 93, 94)
    expect_equal(removed_rows, expected_n3_no_space_redundant_rows)
})

test_that("performance of one linear program", {
	mbm<- microbenchmark("hi" = {maximize_wrench(H_matrix, bounds_tuple_of_numeric, direction = c(1,
        0, 0, 0))}, times=10000)
})

test_that("generate large test set for st tunneling", {
		n_task_values <- 10
    	num_muscles<- ncol(H_matrix)
    	fmax_info <- maximize_wrench(H_matrix, bounds_tuple_of_numeric, direction = c(1,
        0, 0, 0))
	    st_constr_str <- force_cos_ramp_constraint(H_matrix, bounds_tuple_of_numeric,
	    	#assuming that it takes 200ms to go from 0 to 100 percent.
        fmax_info$output_vector_per_task[[1]], 0.5, 0.5, cycles_per_second=4, n_task_values = n_task_values,
        eliminate = FALSE)
        st10_half <- st_constr_str$nonredundant_constr %>% eliminate_redundant2(8)
        st10_half_r0 <- st_constr_str$nonredundant_constr %>% eliminate_redundant
        devtools::use_data(st10_half, overwrite = TRUE)
        har_st10_half <- st10_half %>% pb_har_sample(1e4, mc.cores=8, eliminate=FALSE)
		use_data(har_st10_half, overwrite = TRUE)
})

test_that("performance", {
    n_task_values <- 6
    num_muscles <- ncol(H_matrix)
    fmax_info <- maximize_wrench(H_matrix, bounds_tuple_of_numeric, direction = c(1,
        0, 0, 0))
    st_constr_str <- force_cos_ramp_constraint(H_matrix, bounds_tuple_of_numeric,
        fmax_info$output_vector_per_task[[1]], 0.5, 0.5, n_task_values = n_task_values,
        eliminate = FALSE)

    expected_n5_rm_redundancy <- c(5, 6, 7, 8, 9, 10, 11, 12, 20, 21, 22, 27, 28,
        29, 30, 31, 32, 33, 34, 36, 37, 39, 41, 42, 44, 49, 50, 51, 52, 53, 54,
        55, 56, 57, 58, 59, 61, 63, 66, 71, 72, 73, 74, 75, 76, 77, 78, 80, 81, 83,
        85, 86, 88, 93, 94, 95, 96, 97, 98, 99, 100, 108, 109, 110, 111, 112, 117,
        118, 119, 123, 124, 125, 126, 127, 131, 132, 133, 135, 136, 137, 138, 139,
        140, 142, 143, 144, 145, 146, 147, 148, 152, 153, 154, 158, 159, 160, 161,
        166)
    expect_equal(sort(rownames(res1$constr)),sort(rownames(res2$constr)))
    res1 <- st_constr_str$nonredundant_constr %>% eliminate_redundant
    res4 <- st_constr_str$nonredundant_constr %>% eliminate_redundant2(4)
	points_res1 <- res1 %>% pb_har_sample(1e5, mc.cores=8, eliminate=FALSE)
	points_res4 <- res4 %>% pb_har_sample(1e5, mc.cores=8, eliminate=FALSE)
	expect_true(evaluate_solutions(points_res1, res1, 1e-10) %>% all)
	expect_true(evaluate_solutions(points_res1, res4, 1e-10) %>% all)
	expect_true(evaluate_solutions(points_res4, res1, 1e-10) %>% all)
	expect_true(evaluate_solutions(points_res4, res4, 1e-10) %>% all)

	p_values_distributions <- sapply(1:num_muscles, function(i) {
		ks.test(points_res1[,i],points_res4[,i])$p.value
	})
	expect_true(all(p_values_distributions < 0.01))

	p_values <- sapply(1:num_muscles, function(i) {
		t.test(points_res1[,i],points_res4[,i])$p.value
	})
	expect_true(all(p_values_means < 0.01))

	plot(points_res1[,7],points_res4[,7])
})


library(devtools)
devtools::load_all()

library(parallel)
RNGkind("L'Ecuyer-CMRG")
set.seed(999983)

# para setup

s_q <- 2L
ncores <- 16
s_n <- 1024L
s_k <- 32L

cv2 <- cv_simulation(ncores, s_n, s_k, s_q,
                maxit = 1e4, thresh = 1e-3,
                s_range = 4, l_range = 8)

save(cv2, file = "cv3.RData")


# Check if RStudio is running to set the working directory to the script directory
# https://stackoverflow.com/questions/35986037/detect-if-an-r-session-is-run-in-rstudio-at-startup
is.na(Sys.getenv("RSTUDIO", unset = NA))
if (!is.na(Sys.getenv("RSTUDIO", unset = NA))) {
  # Get current directory
  current_dir <- dirname(rstudioapi::getSourceEditorContext()$path)
  # Set working directory to current directory (script directory)
  setwd(current_dir)
} else {
  # If sourced https://stackoverflow.com/questions/13672720/r-command-for-setting-working-directory-to-source-file-location-in-rstudio
  this.dir <- dirname(parent.frame(2)$ofile)
  setwd(this.dir)
}
# Include the excel helper functions
source("excelhelper.r")

# we will use ggplot2 for our charts
library(ggplot2)
library(dplyr)
library(scales)
library(ggalt)

# Read the input files
world_data<- getTable("world_population")

# Load the dataframe for the map
world_map <- map_data("world")
# Left join the region field of the maps with the country field of our data
# to get all the countries (even the NA ones)
population.map <- left_join(world_map, world_data, by = c("region"="Country"))
ggplot(population.map, aes(long, lat, group = group))+
  geom_polygon(aes(fill = Population ), color = "#EDF1F9")+
  xlab("") + ylab("") +
  scale_fill_gradient(low = "#D8E1F2", high = "#315798", na.value="#E0E0E0", name = "Population", labels = comma) +
  coord_proj("+proj=robin +lon_0=0 +x_0=0 +y_0=0 +ellps=WGS84 +datum=WGS84 +units=m +no_defs") +
  theme(panel.background = element_blank(),
      plot.title = element_text(face = "bold"),
      axis.title.x=element_blank(),
      axis.text.x=element_blank(),
      axis.ticks.x=element_blank(),
      axis.title.y=element_blank(),
      axis.text.y=element_blank(),
      axis.ticks.y=element_blank())

# save the chart
saveChart("world_population",pxwidth = 800, pxheight = 400, dpi = 75)

# Signal the end of the process
done()

# free up all variables
rm(list=ls())


rm(list = ls())

# Load libraries
library(tm)
library(dplyr)
library(readr)
library(lubridate)
library(quanteda)
library(tidytext)
library(tictoc)
library(topicmodels)
library(lda)
library(qdap)
library(RTextTools)
library(stringi)

# Network Graphs Visualization using R and Gephi software
# to visualize similarity-based relationships of documents within a corpus
# Cosine similarity between the documents as the angle between the vectors of them in unique word space

setwd('/home/akanksha/Desktop/Sem III/ML/Course Project/Dataset/pythonquestions')

questions <- read_csv('Questions.csv')
questions$CreationDate <- as.Date(questions$CreationDate)

### filtering questions and answers of year 2008 and month of August
questions_2008 <- filter(questions, year(CreationDate) == "2008" & month(CreationDate) == "8")

### Merging Title and Body columns together into a single column
questions_2008$Text <- paste(questions_2008$Title, " ", questions_2008$Body)
#questions_2008$Text

### Converting into ASCII data
questions_2008$Text <- iconv(questions_2008$Text, to='ASCII', sub='byte')

### Removing all html tags, special characters, control characters, single and double quotes from the dataset
questions_2008$Text <- gsub("<[^>]+>", "", questions_2008$Text)
questions_2008$Text <- gsub("[[:punct:]]", " ", questions_2008$Text)
questions_2008$Text <- gsub("[[:cntrl:]]", " ", questions_2008$Text)
questions_2008$Text <- gsub("'", " ", questions_2008$Text)
questions_2008$Text <- tolower(questions_2008$Text)
questions_2008$Text <- gsub("[[:space:]]", " ", questions_2008$Text)
questions_2008$Text <- gsub("^[[:space:]]+", " ", questions_2008$Text)
questions_2008$Text <- gsub("[[:space:]]+$", " ", questions_2008$Text)
questions_2008$Text <- gsub("[[:digit:]]+", " ", questions_2008$Text)

class(questions_2008$Text)

### Forming a corpus from merged data frame, treating each row as a single document (done with DataframSource())
corpus_questions_2008 <- VCorpus(VectorSource(questions_2008$Text))
writeLines(as.character(corpus_questions_2008[[5]]))

### Removing stop words using standard list of tm library
corpus_questions_2008 <- tm_map(corpus_questions_2008, removeWords, stopwords("english"))
writeLines(as.character(corpus_questions_2008[[5]]))

### Stemming the document
corpus_questions_2008 <- tm_map(corpus_questions_2008, stemDocument)
writeLines(as.character(corpus_questions_2008[[5]]))

### Document Term Matrix
dtm_questions_2008 <-DocumentTermMatrix(corpus_questions_2008, control=list(wordLengths=c(4, 14)))
dtm_questions_2008

# Convert dtm into a matrix
dtm_mat <- as.matrix(dtm_questions_2008)

# Write to a csv file
write.csv(dtm_mat, file = 'dtm_Questions_2008_matrix.csv')

# compute cosine similarity between document vectors
# converting to distance matrix sets diagonal elements to 0
cosineSim <- function(x)
{
     as.dist(x %*% t(x)/(sqrt(rowSums(x^2) %*% t(rowSums(x^2)))))
}

cs <- cosineSim(dtm_mat)

# adjacency matrix: set entries below a certain threshold to 0.
# We choose half the magnitude of the largest element of the matrix
# as the cutoff. This is an arbitrary choice

cs[cs < max(cs)/2 ] <- 0

cs <- round(cs, 3)

write.csv(as.matrix(cs), file = "AdjacencyMatrix.csv")

### Visualization using GEPHI - open source, JAVA based network analysis and visualization tool
# The nodes with the highest connectivity are indicated via node size and colour  (purple for high, green for low)
# and strength of similarity is indicated by edge thickness.


options(bitmapType='cairo')

library(reshape2)
library(ggplot2)

filelist = read.table(parSampleFile1, sep="\t", header=F, stringsAsFactors = F)

finalFile = paste0(outFile, ".csv")
final=NULL
i=1
for(i in c(1:nrow(filelist))){
  filename = filelist$V2[i]
  filelocation = filelist$V1[i]
  if(file.exists(filelocation)){
    subdata = read.table(filelocation, sep="\t", header=T, stringsAsFactors = F)
    subdata$Sample = filename
    final<-rbind(final, subdata)
  }else{
    finalFile = paste0(outFile, ".tmp.csv")
  }
}

write.csv(final, file=finalFile, row.names=F)

height=length(unique(final$Sample)) * 100
#cat(height)
png(file=paste0(finalFile, ".png"), width=9000, height=height, res=300)
g<-ggplot(final, aes(x=Sample, y=Count)) +
  geom_bar(aes(fill=Category), stat = "identity") +
  coord_flip() +
  facet_grid(~Chromosome, scales="free_x") +
  theme_classic() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1))
print(g)
dev.off()


# Loop through all Metabolon Pathways and get a list of unique metabolites.

#' Get All Metabolites In Metabolon's Pathway Knowledgebase
#' @return mets - a character vector of unique metabolites and enzymes found in at least 1 pathway in Metabolon's pathway knowledgebase.
#' @export pathway.ListMetabolites_metabolon
#' @import igraph
#' @examples
#' mets = pathway.ListMetabolites_metabolon()
#' print(mets)
pathway.ListMetabolites_metabolon = function() {
  ig_files = list.files(system.file("extdata/RData/", package="CTD"), pattern = ".RData")
  ig_files = ig_files

  mets = c()
  for (pwy in 1:length(ig_files)) {
    load(system.file(sprintf("extdata/RData/%s", ig_files[pwy]), package="CTD"))
    length(V(ig)$label)
    mets = c(mets, V(ig)$label)
  }
  mets = unique(mets)

  return (mets)
}


# CREATING A TIMELINE GRAPHIC USING R AND GGPLOT2
# https://www.themillerlab.io/post/timelines_in_r/
#
library(ggplot2)
library(scales)
library(lubridate)
library(knitr)

events <- data.frame(
  year        = c(2021, 2021, 2021),
  month       = c(1, 3, 4),
  day         = c(31, 9, 7),
  event       = c("Riapertura scuole", "Chiusura scuole", "Riapertura scuole"),
  restriction = c("Zona Gialla", "Zona Rossa", "Zona Arancione")
)

events$date <- with(events, ymd(sprintf('%04d%02d%02d', year, month, day)))
events <- events[with(events, order(date)), ]

# Add a specified order to these event type labeles
restriction_levels <- c("Zona Rossa", "Zona Arancione", "Zona Gialla")

# Define the colors for the event types in the specified order.
restriction_colors <- c("#ff0000", "#ffa500", "#ffea00")

# Set the heights we will use for our milestones.
positions <- c(-0.5, 1.0, 0.5)

# Set the directions we will use for our milestone, for example above and below.
directions <- c(-1, 1)

# Assign the positions & directions to each date from those set above.
line_pos <- data.frame(
    "date" = unique(events$date),
    "position" = rep(positions, length.out=length(unique(events$date))),
    "direction" = rep(directions, length.out=length(unique(events$date)))
)

# Create columns with the specified positions and directions for each milestone event
events <- merge(x = events, y = line_pos, by = "date", all = TRUE)

# Let's view the new columns.
kable(head(events))

# Create a one month "buffer" at the start and end of the timeline
month_buffer <- 1
month_date_range <- seq(min(events$date) - months(month_buffer), max(events$date) + months(month_buffer), by='month')

# We are adding one month before and one month after the earliest and latest milestone in the clinical course.
## We want the format of the months to be in the 3 letter abbreviations of each month.
month_format <- format(month_date_range, '%b')
month_df <- data.frame(month_date_range, month_format)

year_date_range <- seq(min(events$date) - months(month_buffer), max(events$date) + months(month_buffer), by='year')

# We will only show the years for which we have a december to january transition.
year_date_range <- as.Date(intersect(ceiling_date(year_date_range, unit="year"), floor_date(year_date_range, unit="year")), origin = "1970-01-01")

# We want the format to be in the four digit format for years.
year_format <- format(year_date_range, '%Y')
year_df <- data.frame(year_date_range, year_format)

# Create timeline coordinates with an x and y axis
timeline_plot <- ggplot(events, aes(x = date, y = position, col = restriction, label=events$event))

# Add the label Milestones
timeline_plot <- timeline_plot + labs(col="Milestones")

# Assigning the colors and order to the milestones
timeline_plot <- timeline_plot + scale_color_manual(values = restriction_colors, labels=restriction_levels, drop = FALSE)

# Using the classic theme to remove background gray
timeline_plot <- timeline_plot + theme_classic()

# Plot a horizontal line at y=0 for the timeline
timeline_plot <- timeline_plot + geom_hline(yintercept = 0, color = "black", size = 0.3)

# Plot the vertical lines for our timeline's milestone events
timeline_plot <- timeline_plot + geom_segment(data = events, aes(y = events$position, yend=0, xend = events$date), color='black', size=0.2)

# Now let's plot the scatter points at the tips of the vertical lines and date
timeline_plot <- timeline_plot + geom_point(aes(y = events$position), size=3)

# Let's remove the axis since this is a horizontal timeline and postion the legend to the bottom
timeline_plot<-timeline_plot+theme(axis.line.y=element_blank(),
  axis.text.y=element_blank(),
  axis.title.x=element_blank(),
  axis.title.y=element_blank(),
  axis.ticks.y=element_blank(),
  axis.text.x =element_blank(),
  axis.ticks.x =element_blank(),
  axis.line.x =element_blank(),
  legend.position = "bottom"
)

text_offset <- 0.2
absolute_value<-(abs(events$position))
text_position<- absolute_value + text_offset

events$text_position<- text_position * events$direction

timeline_plot <- timeline_plot + geom_text(aes(y = events$text_position, label = events$event),size=3.5, vjust=0.6)

print(timeline_plot)


###############################################################################
#
# computestats_iit_cpugpu.r - compute average times/speedups fort GPU/CPU on IIT test harness  from timetests.sh output
#
# File:    computestats_iit_cpugpu.r
# Author:  Alex Stivala
# Created: November 2012
#
# Compute GPU/CPU speedup and time stats from timetests.sh output for
# different methods with results from the IIT style test harness.
#
# Usage:
#       R --vanilla --slave -f computestats_iit_cpugpu.r
#
#
#   Reads the rtab files iit_oahttslf_ADDS_DELETES.rtab etc.
#                  e.g.  iit_oahttslf_50_10.rtab
#   in output directories edward_keys1000_output/ etc.
#
#
#    output is LaTeX table on stdout
#
# $Id: plottestspeedup_iit_cpugpu.r 4320 2012-11-11 21:52:23Z astivala $
#
###############################################################################

library(gplots)

#
# globals
#

# these must line up so the GPU output in gpu_fileprefixvec[i] corresponds
# to the CPU output for the same method in cpu_fileprefixvec[i]
cpu_fileprefixvec=c('iit_cpu_oahttslf','iit_cpu_httslf','iit_cpu_lockfreehashtable')
gpu_fileprefixvec=c('iit_gpu_oahttslf','iit_gpu_httslf','iit_gpu_lockfreehashtable')
# and the names line up here
namevec=c('open addressing','separate chaining','IIT')

hostnamevec=c('edward')

# number of keys to run with
numkeys_vec=c(1000,10000,100000,1000000)

# percentages of ADD,DELETE operations
# (the remainder after ADD,DELETE are SEARCH).
opmix_matrix=rbind(c(30,0),c(10,10),c(20,20),c(40,40),c(50,10))

maxthreads <- 8
iterations <- 10

computestats <- function(hostname)
{

  overall_mean_best_cputimes <- c()
  overall_mean_gputimes <- c()
  overall_mean_speedup <- c()

  total_gputime_matrix <- mat.or.vec(length(cpu_fileprefixvec), iterations)
  total_best_cputime_matrix <- mat.or.vec(length(cpu_fileprefixvec), iterations)

  for (numkeys in numkeys_vec) {
    for (i in 1:dim(opmix_matrix)[1]) {
      adds <- opmix_matrix[i,1]
      deletes <- opmix_matrix[i,2]

      mean_speedup_by_thread  <- c()
      stddev_speedup_by_thread  <- c()
      mean_cputime_by_thread <- c()
      gputime_vector <- c()

      for (j in 1:length(cpu_fileprefixvec)) {

        rtabdir <- paste(hostname, "_keys", format(numkeys,scientific=F),
                         "_output", sep='')
        cpu_rtabfile <- paste(cpu_fileprefixvec[j], adds, deletes,sep='_')
        cpu_rtabfile <- paste(cpu_rtabfile,hostname,'rtab',sep='.')
        cpu_rtabfile <- paste(rtabdir, cpu_rtabfile, sep='/')
        cpu_timetab <- read.table(cpu_rtabfile,header=TRUE)
        stopifnot(maxthreads == max(cpu_timetab$threads))
        stopifnot(iterations == max(cpu_timetab$iter))

        gpu_rtabfile <- paste(gpu_fileprefixvec[j], adds, deletes,sep='_')
        gpu_rtabfile <- paste(gpu_rtabfile,hostname,'rtab',sep='.')
        gpu_rtabfile <- paste(rtabdir, gpu_rtabfile, sep='/')
        gpu_timetab <- read.table(gpu_rtabfile,header=TRUE)
        stopifnot(iterations == max(gpu_timetab$iter))

        # we need to get mean for each value of threads for CPU implementation
        # but GPU only run with fixed set of threads

        cpu_times_by_thread_list <- lapply(c(1:maxthreads),
                                          FUN = function(x) subset(cpu_timetab,
                                                                    threads == x)$ms)

        gpu_speedup_by_thread_vector <- (lapply(cpu_times_by_thread_list,
                                              FUN = function(v) v / gpu_timetab$ms))

        mean_speedup_by_thread <-  c(mean_speedup_by_thread,
                                    lapply(gpu_speedup_by_thread_vector, mean))

        stddev_speedup_by_thread <- c(stddev_speedup_by_thread,
                                    lapply(gpu_speedup_by_thread_vector, sd))

        mean_cputime_by_thread <- c(mean_cputime_by_thread,
                                    lapply(cpu_times_by_thread_list, mean))

        gputime_vector <- c(gputime_vector, mean(gpu_timetab$ms))

        total_gputime_matrix[j,] <- total_gputime_matrix[j,] + gpu_timetab$ms

        best_thread <- which.min(lapply(cpu_times_by_thread_list, mean))

        ## print ( j)
        ## print(total_best_cputime_matrix[j,])
        ## print(best_thread)
        total_best_cputime_matrix[j,] <- total_best_cputime_matrix[j,] +
          subset(cpu_timetab, threads == best_thread)$ms

      }

      mean_speedup_by_thread <- unlist(mean_speedup_by_thread)
      stddev_speedup_by_thread <- unlist(stddev_speedup_by_thread)

      n <- length(cpu_fileprefixvec)
      ciw <- qt(0.975, n) * stddev_speedup_by_thread / sqrt(n)

      # convert vector of speedups to matrix where each row is a different method
      gpu_speedup_over_cpu_threads_matrix <- matrix(mean_speedup_by_thread,
                                                    nrow=n, byrow=TRUE)
      ci_matrix <- matrix(ciw, nrow=n, byrow=TRUE)

      mean_cputime_threads_matrix <- matrix(unlist(mean_cputime_by_thread),
                                            nrow=n, byrow=TRUE)

      # get the index in each method (row of matrix) i.e. number of threads
      # for which mean cputime is smallest (i.e. the number of threads on which
      # CPU perofmrance is best for that method)
      best_threads <- lapply(1:n, FUN = function(i)
                             which.min(mean_cputime_threads_matrix[i,]))

      #print(paste(numkeys, adds, deletes))
      for (k in 1:dim(gpu_speedup_over_cpu_threads_matrix)[1]) {
        #print(paste("     ",namevec[k], best_threads[[k]],
        #            mean_cputime_threads_matrix[k, best_threads[[k]]],
        #            gputime_vector[k],
        #            gpu_speedup_over_cpu_threads_matrix[k, best_threads[[k]]]))

        overall_mean_best_cputimes <- c(overall_mean_best_cputimes,
                            mean_cputime_threads_matrix[k, best_threads[[k]]])
        overall_mean_gputimes <- c(overall_mean_gputimes, gputime_vector[k])
        overall_mean_speedup <- c(overall_mean_speedup,
                   gpu_speedup_over_cpu_threads_matrix[k, best_threads[[k]]])

      }
    }
  }

  # convert vector of speedups to matrix where each row is a different method
  overall_mean_best_cputimes_matrix <- matrix(overall_mean_best_cputimes,
                                              nrow=n, byrow=F)
  overall_mean_gputimes_matrix <- matrix(overall_mean_gputimes, nrow=n,
                                         byrow=F)
  overall_mean_speedup_matrix <- matrix(overall_mean_speedup, nrow=n,byrow=F)

  ## print(total_gputime_matrix)#XXX
  ## print(total_best_cputime_matrix)#XXX

  cat("\\begin{tabular}{lrrrrr} \n")
  cat("\\hline\n")
  cat("  & \\multicolumn{2}{c}{mean elapsed time(ms)} & \\\\ \n")
  cat("implementation & CPU & GPU  & speedup \\\\ \n")
  cat("\\hline\n")
  for (k in 1:n) {
      cputime_ciw <- qt(0.975, iterations) * sd(total_best_cputime_matrix[k,]) / sqrt(iterations)
      gputime_ciw <- qt(0.975, iterations) * sd(total_gputime_matrix[k,]) / sqrt(iterations)

    cat(sprintf("%20s & $%.0f \\pm %.1f$ & $%.0f \\pm %.1f$ & %.1f \\\\ \n",
                namevec[k],
                mean(total_best_cputime_matrix[k,]), cputime_ciw,
                mean(total_gputime_matrix[k,]), gputime_ciw,
                mean(total_best_cputime_matrix[k,]) / mean(total_gputime_matrix[k,])
               ))
  }
  cat("\\hline\n")
  cat("\\end{tabular}\n")
  #print(overall_mean_gputimes_matrix)
}

#
# main
#

for (hostname in hostnamevec) {
  computestats(hostname)
}


#DICOM Position Extraction
dicom_data<-function(patient){

    #values of interest to extract
    gantry.angle<-extractHeader(patient$hdr, "GantryAngle")
    gantry.direction<-extractHeader(patient$hdr, "GantryRotationDirection", numeric=FALSE)
    patient.id<-extractHeader(patient$hdr, "PatientID")
    prescribed.dose<-extractHeader(patient$hdr, "TargetPrescriptionDose")
    beam.energy<-extractHeader(patient$hdr, "NominalBeamEnergy")
    num.points<-extractHeader(patient$hdr,"NumberOfControlPoints")
    beam.dose<-extractHeader(patient$hdr, "BeamDose")
    cps<-extractHeader(patient$hdr, "LeafJawPositions", numeric=FALSE)
    #Remove the 4 entries corresponding to MLC initial positions
    cps<-cps[-c(1,2, num.points[1]+3, num.points[1]+4)]

    beam.dose <- c(rep(beam.dose[1], num.points[1]), rep(beam.dose[2], num.points[2]))

    #Cleanup and save
    dat <- data.frame(patient.id,beam.energy,gantry.angle, gantry.direction,beam.dose,cps)
    colnames(dat)<- c("ID", "Energy", "GantryAngle", "GantryDirection", "BeamDose", "ControlPoints")
    return(dat)

}


#' Extract PRISM climate data for a particular site by year_month combination.
#' This function takes a data frame that contains columns of:
#' year_month in the form: "2014-01"
#' NEON site as "BART" or similar
#' latitude and longitude
#' depends on raster, and sp packages.
#'
#' @param data data frame with site, year_month, latitude and longitude columns.
#' @param prism.dir path to directory that contains prism files. Currently defaults to directory in Colin's data folder.
#'
#' @return returns of a data frame of 30-year mat and map normals as well as location-month specific tmean, tmin, tmax, and ppt.
#' @export
#'
#' @examples
prism_query <- function(data,prism.dir = '/fs/data3/caverill/PRISM/'){
  #grab longitude and latitude from data frame.
  points <- cbind(data$longitude, data$latitude)

  #get unique year-month-site combinations
  data$year_month_site <- paste(data$year_month,data$site, sep = '_')
  dates <- data[!duplicated(data$year_month_site),c('year_month_site','year_month','site','latitude','longitude')]
  dates$year  <- substr(dates$year_month,1,4)
  dates$month <- substr(dates$year_month,6,7)

  #extract 30-year products, create a data frame.
  map30 <- extract(raster(paste0(prism.dir,'PRISM_ppt_30yr_normal_800mM2_annual_bil/PRISM_ppt_30yr_normal_800mM2_annual_bil.bil')),points)
  mat30 <- extract(raster(paste0(prism.dir,'PRISM_tmean_30yr_normal_800mM2_annual_bil/PRISM_tmean_30yr_normal_800mM2_annual_bil.bil')),points)

  to_return <- data.frame(data$year_month_site, map30, mat30)
  colnames(to_return)[1] <- 'year_month_site'

  #create output list for looping monthly data extraction.
  out.list <- list()

  #loop through each unique site by date combination.
  for(i in 1:nrow(dates)){
    points <- cbind(dates$longitude[i],dates$latitude[i])
    yr <- dates$year[i]
    mo <- dates$month[i]

    #extract for each variable of interest.
    tmean <- extract(raster(paste0(prism.dir,'PRISM_tmean_stable_4kmM2_',yr,mo,'_bil/PRISM_tmean_stable_4kmM2_',yr,mo,'_bil.bil')),points)
    tmin  <- extract(raster(paste0(prism.dir,'PRISM_tmin_stable_4kmM2_',yr,mo,'_bil/PRISM_tmin_stable_4kmM2_',yr,mo,'_bil.bil')),points)
    tmax  <- extract(raster(paste0(prism.dir,'PRISM_tmax_stable_4kmM2_',yr,mo,'_bil/PRISM_tmax_stable_4kmM2_',yr,mo,'_bil.bil')),points)
    ppt   <- extract(raster(paste0(prism.dir,'PRISM_ppt_stable_4kmM3_',yr,mo,'_bil/PRISM_ppt_stable_4kmM3_',yr,mo,'_bil.bil')),points)

    #group it up, put it in output list
    all <- c(tmean,tmin,tmax,ppt)
    out.list[[i]] <- all
  }

  #collapse output list
  out <- data.frame(do.call('rbind',out.list))
  colnames(out) <- c('tmean','tmin','tmax','ppt')
  out$year_month_site <- dates$year_month_site

  #merge 30 year and monthly data
  to_return <- merge(to_return,out, all.x = T)
  to_return <- to_return[,-1]

  #return a dataframe with the climate variables
  return(to_return)
}


install.packages(c('dendsort', 'RcppArmadillo', 'rjson', 'RMTstat', 'Rook', 'fastcluster'),
                 repos='https://cloud.r-project.org')

install.packages("devtools", repos='https://cloud.r-project.org')
                                        # Install Bioconductor dependencies
if (!requireNamespace("BiocManager"))
    install.packages("BiocManager", repos='https://cloud.r-project.org')
BiocManager::install(ask=F,update=F)
BiocManager::install("GO.db", version = "3.8",ask=F,update=F)
BiocManager::install("org.Hs.eg.db", version = "3.8",ask=F,update=F)
BiocManager::install("org.Mm.eg.db", version = "3.8",ask=F,update=F)
BiocManager::install("pcaMethods", version = "3.8",ask=F,update=F)
library(devtools)
install_github("igraph/rigraph") # Don't install with install.packages()
install_github("jkrijthe/Rtsne",ref="openmp")
install.packages(c("Cairo","urltools"), repos='https://cloud.r-project.org')


source(paste0(dir_script_ed, '/01-prep/prep1/util.r'))

# Read data
df <- get_species_raw_data()

# Assess data quality for lat and lon
li_df <- assess_latlon(df, filepath_log)

# Lookup based on country for those rows with no lat/lon
# to assign latitude column
join_cty <- lookup_for_no_ll_lt(li_df$join_cty)

# Combine files
join <- rbind(li_df$join_ll, join_cty, fill = T)

# Create latitude reference lines
ref_lines <- create_latitude_lines(lat, lat_splits)

# Create latitude column
join <- assign_latitude(join, ref_lines)
join[,
    list(min=min(lat_n), max=max(lat_n), .N), by="latitude"
][order(min)]

# Subset relevant columns
cols_ll_final <- c(cols_std,  "latitude")
join <- join[, ..cols_ll_final]

# Log relevant statistics
write_ending_log(join, filepath_log)

# Format data and write as data.csv
format_data(join, dir_model_folder)


# plot timepoints
plots.timepoints <- function(x, y, samples, timepoints){
  fig_by_month <- plot_ly(x = x, y = y,
          type = "scatter",
          color = timepoints, colors = brewer.pal(n = length(timepoints), name = "Set1"),
          mode = "markers") %>%
          layout(title = 'Timepoint')
  fig_by_month
}

# plot samples
plots.samples <- function(x, y, samples, timepoints){
	fig_by_sample <- plot_ly(x = x, y = y,
							 color = samples, colors = brewer.pal(n = length(samples), name = "Set1"),
							 text = timepoints,
							 type = "scatter", mode = "markers") %>%
			layout(title = 'Samples') %>%
			add_text(textposition = "top right")
	fig_by_sample
}

# plot classification
plots.classification <- function(x, y, centroid_allocations){
  fig_by_classification <- plot_ly(x = x, y = y,
           color = as.vector(centroid_allocations), colors = brewer.pal(n = length(centroid_allocations), name = "Set1"),
           type = "scatter", mode = "markers")
   fig_by_classification <- fig_by_classification %>% layout(title = 'Classification')
   fig_by_classification
}

#plot specific individual
plots.individual <- function(x, y, samples, timepoints, individual){

  individual.index <- which(startsWith(samples, paste("X", individual, sep = '')))

  x.individual <- x[individual.index]
  y.individual <- y[individual.index]

  individual.timepoints <- timepoints[individual.index]
  individual.samples <- samples[individual.index]

  fig_by_sample <- plot_ly(x = x.individual, y = y.individual,
                           text = individual.timepoints,
                           type = "scatter", mode = "markers") %>%
    layout(title = individual) %>%
    layout(showlegend = FALSE) %>%
    add_text(textposition = "top right")
  fig_by_sample
}

plots.network <- function(transition.matrix, time.point.list){

  g <- graph_from_adjacency_matrix(transition.matrix, weighted = T, mode = 'directed')
  edge.list <- get.data.frame(g, what = 'edges')
  node.list <- get.data.frame(g, what = 'vertices')

  x <- c()
  y <- c()
  tm.rownames <- rownames(transition.matrix)
  for (rowname in tm.rownames){

    timepoint <- unlist(strsplit(rowname, ".", fixed = T))[1]
    cluster <- unlist(strsplit(rowname, ".", fixed = T))[2]
    x <- c(x, which(timepoint == time.point.list))

    rownames.of.timepoint <- tm.rownames[str_starts(tm.rownames, timepoint)]
    y <- c(y, which(endsWith(rownames.of.timepoint, cluster)))
  }

  node.list$x <- x
  node.list$y <- y

  new_g <- graph_from_data_frame(d = edge.list, directed = T, vertices = node.list)
  plot(new_g,
       vertex.size=30,
       edge.label=round(edge.list$weight, 2),
       edge.width=round(edge.list$weight * 5, 2),
       xlim=c(0,0))
}

plots.multi.timepoint.clustering <- function(mds, clusterings){

  rownames.of.x <- rownames(mds)

  # adjust clustering values, so that plot of clustering per timepoint in readable ...
  merged.clustering.by.ch <- array(dim = nrow(mds))

  index = 1
  for(i in rownames.of.x){
    sample <- substr(i, start = 2, stop = 4)
    timepoint <- substr(i, start = 5, stop = 7)

      clustering <- NULL
      for(j in clusterings)
        if(j$timepoint == timepoint) clustering = j

      value <- as.integer(clustering$best.clustering_by_ch[i])
      merged.clustering.by.ch[index] = paste(timepoint, value, sep='-')
      index = index + 1

  }

  fig_by_classification <- plot_ly(x = mds[,1], y = mds[,2], type = "scatter", mode = "markers"
                                   ,text = as.vector(merged.clustering.by.ch)
                                   ,color = as.vector(merged.clustering.by.ch)
                                   ,colors = brewer.pal(n = length(merged.clustering.by.ch), name = "Set1")
                                   )
  fig_by_classification <- fig_by_classification %>% add_text(textposition = "top right")
  fig_by_classification <- fig_by_classification %>% layout(title = 'Classification')
  fig_by_classification
}


include	defs

# slstr --- slice a substring from a string

   integer function slstr (from, to, first, chars)
   character from (ARB), to (ARB)
   integer first, chars

   integer len, i, j, k
   integer length

   len = length (from)

   i = first
   if (i < 1)
      i = i + len + 1

   if (chars < 0) {
      i = i + chars + 1
      chars = - chars
      }

   j = i + chars - 1
   if (i < 1)
      i = 1
   if (j > len)
      j = len

   for (k = 0; i <= j; k = k + 1) {
      to (k + 1) = from (i)
      i = i + 1
      }
   to (k + 1) = EOS

   return (k)
   end


library(jsonlite)
library(readr)

library(colorspace)
library(gridExtra)

# read last_date
load('data/latest/last_date_.Rda')

# gmt to gmt + 1
generated_time <- format(Sys.time() + as.difftime(1, units="hours"), '%d.%m.%Y. %H:%M:%S h')

md_source <- paste('# COVID 19 u Hrvatskoj: Pregled broja zaraženih po županijama\n\n',
                   '### (generirano ',  generated_time, ')\n\n',
                   '#### NAPOMENA (04.11.2021.): Stranica se generira automatski. Ako ima grešaka u strojno čitljivim podacima objavljenim na koronavirus.hr, prikazani grafovi neće biti točni. U tom slučaju pokušat ću ih ispraviti čim nađem vremena.\n\n',
                   '#### NAPOMENA (15.01.2022.): Od danas se koriste podaci iz popisa stanovništva 2021. u svim prikazima u kojima je to moguće. U prikazima po dobnim skupinama i dalje se koriste podaci iz 2019. jer detaljniji podaci još nisu dostupni. Promijenjene su skale na nekim grafovima kako bi bili informativniji.\n\n',
                   'Interaktivni prikazi dostupni su na sljedećim linkovima:\n\n',
                   '- [Standardni prikaz](html/index.html) (zadnjih 100 dana)\n',
                   '- [Prikaz na logaritamskoj skali](html/index_log.html) (zadnjih 100 dana)\n',
                   '- [Prikaz na karti](html/index_map.html) (tjedna promjena, zadnjih 7 i 14 dana na 100000 stanovnika)\n',
                   '- [Prikaz po dobnim skupinama](html/index_per_age.html) (zadnjih 180 dostupnih dana)\n',
                   '- [Prikaz po dobnim skupinama i spolu](html/index_pyramid.html) (zadnjih 7 dostupnih dana, na 100000 stanovnika)\n',
                   '- [Prikaz procijepljenosti na karti](html/index_vaccination.html) (zadnji dostupni podaci, ne osvježava se automatski)\n\n',
                   '-----\n\n',
                   '## Pregled broja zaraženih po županijama\n\n',
                   '![](img/', last_date_, '_line_plots.png)\n\n',
                   '## Pregled tjedne promjene broja zaraženih po županijama\n\n',
                   '![](img/', last_date_, '_map.png)\n\n',
                   '## Kretanje broja COVID-19 slučajeva, hospitalizacija i umrlih\n\n(napomena: podaci o hospitalizacijama i broju osoba na respiratorima se ne objavljuju svakodnevno, prikazani su zadnji dostupni podaci)\n\n',
                   '![](img/', last_date_, '_cases_hospitalisations_deaths.png)\n\n',
                   '![](img/', last_date_, '_cases_hospitalisations_deaths_log.png)\n\n',

                   '## Kretanje udjela pozitivnih testova\n\n(zadnji dostupni podaci)\n\n',
                   '![](img/', last_date_, '_percentage_positive_tests.png)\n\n',

                   '## Kretanje broja COVID-19 slučajeva na 100 tisuća stanovnika po dobnim skupinama\n\n',
                   '![](img/', last_date_, '_cases_per_age_group_lines.png)\n\n',
                   '![](img/', last_date_, '_cases_per_age_group_lines_log.png)\n\n',

                   '## Animirani prikaz kretanja broja COVID-19 slučajeva na 100 tisuća stanovnika po dobnim skupinama\n\n',
                   '![](img/', last_date_, 'anim_aug_1200.gif)\n\n',
                   '![](img/anim_cases_', last_date_, '_vs_2020.gif)\n\n',
                   '![](img/', last_date_, 'all_counties_dots.png)\n\n',
                   '## Ukupan broj zaraženih u zadnjih 7 dana na 100000 stanovnika\n\n',
                   '![](img/', last_date_, '_map_7_day_per_100k.png)\n\n',
                   '## Ukupan broj zaraženih u zadnjih 14 dana na 100000 stanovnika\n\n',
                   '![](img/', last_date_, '_map_14_day_per_100k.png)\n\n',
                   '## Ukupan broj zaraženih u zadnjih 14 dana na 100000 stanovnika po regijama\n\n(napomena: kod ECDC-a boja regije ovisi i o postotku pozitivnih testova, ovdje je prikazan samo broj slučajeva)\n\n',
                   '![](img/', last_date_, '_map_14_day_per_100k_region.png)\n\n',
                   '(Trend kretanja 14-dnevnog broja slučajeva na 100k stanovnika opisan eksponencijalnom krivuljom n(t) = a * e^(b * t) po regijama. Krivulja aproksimira podatke zadnjih 7 dana, izračunate iz podataka objavljenih na koronavirus.hr, koristeći broj stanovnika po županijama iz 2019. s dzs.hr. Krivulja se prikazuje ukoliko je R^2 aproksimacije > 0.95, prikazana je narančastom bojom. Zelena krivulja prikazuje vrijednosti aproksimacijske krivulje 7 dana u budućnosti (deblja linija), dok su tanjom zelenom linijom prikazane vrijednosti krivulje do dana u kojem bi vrijednost mogla doći do praga od 75/200 zaraženih na 100k stanovnika. Generirano automatski, nakon objave službenih podataka na koronavirus.hr.)\n\n',
                   '![](img/', last_date_, '_current_Jadranska_Hrvatska.png)\n\n',
                   '![](img/', last_date_, '_current_Panonska_Hrvatska.png)\n\n',
                   '![](img/', last_date_, '_current_Grad_Zagreb.png)\n\n',
                   '![](img/', last_date_, '_current_Sjeverna_Hrvatska.png)\n\n',
                   '![](img/', last_date_, '_current_Republika_Hrvatska.png)\n\n',
                   '![](img/', last_date_, '_cases_hospitalisations_deaths_Republika_Hrvatska.png)\n\n',
                   '## Procijepljenost po županijama\n\n(ne osvježava se automatski)\n\n',
                   '![](img/', last_date_, '_vaccination.png)\n\n',
                   '## Pregled broja zaraženih po dobnim skupinama na 100000 stanovnika\n\n',
                   '(Podaci kasne par dana, prikazano stanje nije finalno.)\n\n',
                   '![](img/', last_date_, '_per_age_group.png)\n\n',
                   '![](img/', last_date_, '_per_age_group_all_0.png)\n\n',
                   '![](img/', last_date_, '_per_age_group_all_1.png)\n\n',
                   '## Pregled broja zaraženih po dobnim skupinama i spolu (u zadnjih 7 dostupnih dana) na 100000 stanovnika\n\n',
                   '(Podaci kasne par dana, prikazano stanje nije finalno.)\n\n',
                   '![](img/', last_date_, '_pyramid.png)\n\n',
                   '-----\n\n',
                   '- [Kod](https://github.com/ppalasek/covid_plots_croatia)\n', sep='')

writeLines(md_source, 'index.md')


get_val_from_list <- function(list_vals,to_match){
  return(list_vals[which(names(list_vals)==to_match ) ])}

# identify_english_translation <- function(json_data,original_value){
#   translate_list <- get_val_from_list(list_vals = json_data,to_match = original_value)
#   return(translate_list[[1]]$English[[1]][2])}

gen_random_word <- function(text_data){return(sample(x = text_data$V1,prob =1- text_data$Percent,size = 1))}

identify_english_translation <- function(json_data,original_value){
    translate_list <- get_val_from_list(list_vals = json_data,to_match = original_value)[[1]]
    english_word <- translate_list$English[[1]][2]
    # print(english_word)bv
    french_result <- translate_list$`French Sentence`[1]
    english_result <- translate_list$`English Sentence`[[1]][2]
    return(list("Translation" = english_word,
              "Original.Sentence" = french_result,
              "Translated.Sentence" = english_result) )}

recalc_probs <- function(text_for_recalc){
  return_text <- text_for_recalc[,Percent := Percent/sum(Percent)]
  return(return_text)}

highlight <- function(text, search){
  x <- unlist(strsplit(text, split = " ", fixed = T))
  x[tolower(x) == tolower(search)] <- paste0("<mark>", x[tolower(x) == tolower(search)], "</mark>")
  paste(x, collapse = " ")}

#Example:
# text_data_2 <- recalc_probs( text_data[order(Percent,decreasing = T)][c(1,2,3,4)])
#
# library(pacman)
# library(data.table)
# library(reshape2)
# library(rmarkdown)
# library(shiny)
# library(knitr)
# library(ggplot2)
# library(RJSONIO)
# # p_load(data.table,reshape2,rmarkdown,shiny,knitr,ggplot2,RJSONIO)
# text_data <- fread("Adaptive_Flashcards/Ngram Frequencies.csv")
# json_data <- RJSONIO::fromJSON("Adaptive_Flashcards/Mapping Information.json")
# processed_text <- identify_english_translation(json_data = json_data,original_value = gen_random_word(  text_data  ))


  lonlat2planar = function ( x, proj.type, input_names=c("lon", "lat"), newnames = c("plon", "plat") ) {
    #\\ convert lon/lat to a projected surface using proj
    #\\ proj.type can be an internal code such as "utm20" or a proj4 argument
    #\\ output scale is defined in the +units=km (default for bio) or +units=m (default for proj)
    # first try an internal conversion /lookup for CRS
    pjj = NULL
    pjj = projection_proj4string(proj.type)
    if (!is.null(pjj)) {
      proj4.params = try( sp::CRS( pjj ), silent=TRUE )
    } else {
      proj4.params = try( sp::CRS( proj.type ), silent=TRUE )
    }

    if ( "try-error" %in% class( proj4.params) ) {
      if (!is.null(proj.type)) proj4.params = try( sp::CRS( as.character(proj.type) ), silent=TRUE )
    }
    if ( "try-error" %in% class( proj4.params) ) {
      print( proj.type )
      warning( "Projection not recognised")
    }

    crsX = rgdal::CRSargs( proj4.params)
    if ( ! grepl("units", crsX) ) {
      print (crsX)
      stop( "The proj4 CRS requires an explicit +units=km ")
    }

    y = rgdal::project( as.matrix(x[,input_names]), proj=crsX , inv=F )
    colnames(y) = newnames
    for (i in 1:length( newnames)) {
      if ( newnames[i] %in% colnames(x) ) x[, newnames[i]] = NULL
    }
    x = as.data.frame(cbind(x,y))
    return (x)
  }


setwd(file.path(Sys.getenv("MESSAGE_IX_PATH"), "tutorial"))

suppressPackageStartupMessages(library(optparse, quietly=TRUE))

# cli
option_list = list(
    make_option(c("--props"), type="character",
                help=paste("testdb props path"),
                metavar="character")
);
opt_parser = OptionParser(option_list=option_list);
opt = parse_args(opt_parser);

source(file.path(Sys.getenv("IXMP_R_PATH"), "ixmp.R"))

mp = ixPlatform(dbprops=opt$props)

# test not message
model <- "canning problem"
scenario <- "standard"
scen <- mp$Scenario(model, scenario)
scen$check_out()
scen$init_var('z', NULL, NULL)
scen$commit('foo')
scen$solve(model='transport_ixmp')

stopifnot(scen$var('z')['level'] == 153.675)


# R code
# Luis P. F. Garcia 2018
# Induce, evaluate and export the model

save <- function(model, wtype, ftype, size) {
  aux = list(model=model, wtype=wtype, ftype=ftype, size=size)
  saveRDS(aux, "model.rds")
}

oracle <- function(tran, test, wtype, ftype, size) {
  test = window(test, wtype, ftype, size)
  tran = window(tran, wtype, ftype, size)
  classifiers(tran, test)
}

evaluation <- function(wtype, ftype, size) {

  data = kfold(read(FILES))

  result = mapply(function(tran, test) {
    oracle(tran, test, wtype, ftype, size)
  }, tran=data$tran, test=data$test,
  SIMPLIFY=FALSE)

  model = extract(data, result, wtype, ftype, size)
  save(model, wtype, ftype, size)
  return(result)
}


source("./ETL/CountrySources/util.r")
source("./Data/column_constants.r")

# Given a set of regions plot as lines related to an ID parameter
PlotDimensionForRegionSet <- function(data, x_col_name, region_ids, region_id_col_name, dimension_name, line_colors) {
    data <- data[data[[region_id_col_name]] %in% region_ids, ]

    plot(data[[x_col_name]], data[[dimension_name]], main=paste("Coronavirus -", dimension_name), xlab="Days since 100 cases", ylab=dimension_name, type="l", lty=0)
    for(i in region_ids) {
        region_data <- data[data[[region_id_col_name]] == i, ]
        lines(region_data[[x_col_name]], region_data[[dimension_name]], col=line_colors[i])
    }
    legend("topleft", legend=region_ids, lwd=1, col=line_colors)
}

# Plots lines for all regions in a given data set
PlotDimensionForRegions <- function(data, x_col_name, region_id_col_name, dimension_name, line_colors) {
    regions <- unique(data[[region_id_col_name]])

    plot(data[[x_col_name]], data[[dimension_name]], main=paste("Coronavirus -", dimension_name), xlab="Days since 100 cases", ylab=dimension_name, type="l", lty=0)
    for(i in regions) {
        region_data <- data[data[[region_id_col_name]] == i, ]
        lines(region_data[[x_col_name]], region_data[[dimension_name]], col=line_colors[i])
    }
}

# Draws 4 graphs to one plot and adds a legend at the bottom
GraphDimensionForCountry <- function(spain_community_data, spain, dimension_name, country_name, color_codes) {
    regions <- unique(spain_community_data[["region_code"]])

    # Graph drawing sections
    # Prep canvas to have 4 graphs and a bottom margin for the legend
    par(mfrow=c(2,2), oma=c(4,1,1,1))

    total_dimension_name = paste("total_", dimension_name, sep = "")
    daily_dimension_name = paste("daily_", dimension_name, sep = "")

    DrawGraphForCountry(spain, total_dimension_name, country_name)
    DrawGraphForCountry(spain, daily_dimension_name, country_name)
    PlotDimensionForRegions(spain_community_data, "date", "region_code", total_dimension_name, color_codes)
    PlotDimensionForRegions(spain_community_data, "date", "region_code", daily_dimension_name, color_codes)

    par(fig = c(0, 1, 0, 1), oma = c(0, 0, 0, 0), mar = c(0, 0, 0, 0), new = TRUE)
    plot(0, 0, type = "n", bty = "n", xaxt = "n", yaxt = "n")
    legend("bottom", inset=c(0,0), legend=regions, xpd=TRUE, lwd=1, col=color_codes, horiz=TRUE, cex=0.5)
}

# Draws a graph for all of a country
DrawGraphForCountry <- function(country_data, dimension_name, country_name) {
    plot(country_data$date, country_data[[dimension_name]], main=paste(country_name, dimension_name, sep=" - "), xlab="Date", ylab=dimension_name, type="l")
}

# Output all available graphable dimensions as png
OutputAllDimensionsAsPng <- function(regional_data, country_data, country_name, color_codes) {
    na_columns <- apply(regional_data, 2, function(x) any(is.na(x)))

    # Generate output path
    output_path <- paste("Output/", country_name, sep="")
    dir.create(output_path, showWarnings = FALSE)

    for(i in GRAPHABLE_COLUMN_ROOT_NAMES) {
        total_name <- paste("total_", i, sep="")
        if(!na_columns[total_name]) {
            file_name <- paste(output_path, "/", i, ".png", sep="")
            png(file_name)
            GraphDimensionForCountry(regional_data, country_data, i, country_name, color_codes)
            dev.off()
        }
    }
}