R/save.plots.label.html.R

In kridsadakorn/ipcaps.bioc: Iterative Pruning to Capture Population Structure

#' Generate HTML file for scatter plots which data points are highlighted by
#' given labels
#'
#' @description Generate HTML file called 'tree_scatter_label.html' from the
#' result of \code{\link{ipcaps}}. This function is a part of workflow in
#' \code{\link{save.plots}}. The clustering result is shown as a tree rendering
#' by the online Google Organizational Chart library. Note that the Internet is
#' required to view the HTML file.
#'
#' @param output.dir A result directory as the \code{$output} object returned
#' from the \code{\link{ipcaps}} function.
#'
#' @return \code{NULL}
#'
#' @details After running, this function generates the file called
#' 'tree_scatter_label.html' in the same result directory. All plots are
#' generated and saved as image files in the sub-directory 'images'.
#'
#' @export
#'
#' @include output.template.R
#'
#' @seealso \code{\link{save.html}},
#' \code{\link{save.plots}},
#' \code{\link{save.plots.cluster.html}},
#' and \code{\link{save.eigenplots.html}}
#'
#' @examples
#'
#' # Importantly, bed file, bim file, and fam file are required
#' # Use the example files embedded in the package
#'
#' BED.file <- system.file('extdata',
#'                         'ipcaps_example.bed',
#'                         package = 'IPCAPS.BIOC')
#'
#' LABEL.file <- system.file('extdata',
#'                           'ipcaps_example_individuals.txt.gz',
#'                           package = 'IPCAPS.BIOC')
#'
#' my.cluster <- ipcaps(bed = BED.file,
#'                      label.file = LABEL.file,
#'                      lab.col = 2,
#'                      out = tempdir(),
#'                      max.thread = 1,
#'                      seed = 1234)
#'
#' #Here, to generate HTML file
#' save.plots.label.html(my.cluster$output.dir)


save.plots.label.html <- function(output.dir)
{
    tree <- NULL
    index <- NULL
    min.in.group <- NULL
    leaf.node <- NULL

    load(file.path(output.dir, "RData", "leafnode.RData"))
    load(file.path(output.dir, "RData", "tree.RData"))
    load(file.path(output.dir, "RData", "rawdata.RData"))
    load(file.path(output.dir, "RData", "condition.RData"))
    global.label <- label
    node.list <- sort(tree$node)

    txt_leafnode <- ""
    txt_data <- ""

    test.dir <- file.path(output.dir, "images.new")
    img.dir <- "images"
    if (file.exists(test.dir))
    {
        img.dir <- "images.new"
    }

    for (i in node.list)
    {
        parent_node <- ""
        if (i > 1)
        {
            parent_node <- tree$parent.node[which(tree$node == i)]
        }
        PCs.file <-
            file.path(output.dir, "RData", paste0("node", i, ".RData"))
        load(PCs.file)
        label <- global.label[index]
        list.sum <- c()
        u.label <- sort(unique(label))
        for (j in seq(1, length(u.label)))
        {
            co <- length(label[label == u.label[j]])
            strout <- paste0(u.label[j], "&nbsp;(", co, ")")
            list.sum <- c(list.sum, strout)
        }
        content <- ""
        for (s in list.sum)
        {
            content <- paste0(content, s, "<br>")
        }
        if (file.exists(file.path(
            output.dir,
            "images",
            paste0("scatter_by_label_preview",
                    i, ".jpg")
        )))
        {
            txt_data <- paste0(
                txt_data,
                "[{v:'",
                i,
                "', f:'<div class=\"box_class\" align=\"center\">",
                "<p class=\"head_class\">Node ",
                i,
                "</p><a href=\"",
                img.dir,
                "/scatter_by_label",
                i,
                ".png\" target=\"_blank\"><img src=\"",
                img.dir,
                "/scatter_by_label_preview",
                i,
                ".jpg\" width=200 height=200>",
                "<br />view</a></div>'}, '",
                parent_node,
                "', '']"
            )
        } else if (file.exists(file.path(
            output.dir,
            "images",
            paste0("scatter_by_label_preview",
                    i, ".pdf")
        )))
        {
            txt_data <- paste0(
                txt_data,
                "[{v:'",
                i,
                "', f:'<div class=\"box_class\" align=\"center\">",
                "<p class=\"head_class\">Node ",
                i,
                "</p><a href=\"",
                img.dir,
                "/scatter_by_label",
                i,
                ".pdf\" target=\"_blank\"><embed src=\"",
                img.dir,
                "/scatter_by_label_preview",
                i,
                ".pdf\" width=200 height=200>",
                "<br />view</a></div>'}, '",
                parent_node,
                "', '']"
            )
        } else
        {
            txt_data <- paste0(
                txt_data,
                "[{v:'",
                i,
                "', f:'<div class=\"box_class\">",
                "<p class=\"head_class\">Node ",
                i,
                "</p><p class=\"subhead_class\">under cutoff (<",
                min.in.group,
                ")</p><br>",
                content,
                "</div>'}, '",
                parent_node,
                "', '']"
            )
        }
        if (!(i == node.list[length(node.list)]))
        {
            txt_data <- paste0(txt_data, ",\n")
        } else
        {
            txt_data <- paste0(txt_data, "\n")
        }

        no_idx <- which(i == node.list) - 1
        if (i %in% leaf.node)
        {
            txt_leafnode <- paste0(
                txt_leafnode,
                "data.setRowProperty(",
                no_idx,
                ", 'style', 'border: 3px solid #DB6E6E; ",
                "background-color:#FFE1E1');\n"
            )
        }
    }

    txt_title <- "Scatterplots colored by predefined labels"
    txt_body <- "Scatterplots colored by predefined labels"

    txt_html <- output.template$template
    txt_html[output.template$lno_data] <- txt_data
    txt_html[output.template$lno_leafnode] <- txt_leafnode
    txt_html[output.template$lno_body] <- txt_body
    txt_html[output.template$lno_title] <- txt_title

    fo <- file(file.path(output.dir, "tree_scatter_label.html"), "w")
    for (i in txt_html)
    {
        write(i, fo)
    }
    close(fo)

    invisible(NULL)
}