R/plotWF.R

In systemPipeR/systemPipeShiny: systemPipeShiny: An Interactive Framework for Workflow Management and Visualization

## Internal funcs for plotting Workflow


# Graphviz plot workflow
# df_wf: data frame, the standard df generated from subsetRmd function
# out_type: choose from 'html', 'svg', 'png'
# out_path: string, path of output plot, only apply from svg or png
# plot_style:  one of 'detect', 'none', 'linear'
# default is detect, ignoring level but detecting the the longest branch
# linking first and last step as main branch.
# height: int, height of svg or png in pixels, default NULL, automatic
# width: int, width of svg or png in pixels, default NULL, automatic
# only selected steps will be plotted, make sure at least some steps are
# TRUE in 'selected' column in df_wf

#' #' @importFrom assertthat is.count
#' # @importFrom rsvg rsvg_svg rsvg_png
#' #' @noRd
#' .plotWF <- function(df_wf, plot_style="detect", out_type='html',
#'                    out_path='default', height=NULL, width=NULL){
#'     # pre checks
#'     assert_that(out_type %in% c('html', 'png', 'svg', 'shiny'),
#'                 msg = "output type needs to be one of 'html', 'png', 'svg'")
#'     assert_that(plot_style %in% c('detect', 'none', 'linear'),
#'                 msg="plot style needs to be one of 'detect', 'none', 'linear'")
#'     assert_that(is.data.frame(df_wf))
#'     all(c("t_lvl", "t_number", "t_text","selected",
#'           "no_run", "no_success", "link_to") %in% names(df_wf)) %>%
#'         assert_that(msg=glue('One of following columns is missing: "t_lvl"',
#'                              '"t_number" "t_text" "selected"',
#'                              '"no_run" "no_success" "link_to"'))
#'     if (out_path == 'default' & !out_type %in% c('html', 'shiny')){
#'         assert_that(is.writeable(out_path))
#'         assert_that(is.count(height) | is.null(height))
#'             assert_that(is.count(width) | is.null(width))
#'         out_path = switch(out_type,
#'                           'svg' = paste0('wfplot',
#'                                          format(Sys.time(), "%Y%m%d%H%M%S"),
#'                                          '.svg'),
#'                           'png' = paste0('wfplot',
#'                                          format(Sys.time(), "%Y%m%d%H%M%S"),
#'                                          '.png')
#'         )
#'     }
#'     df_wf <- df_wf[df_wf$selected == TRUE, ]
#'     if (nrow(df_wf) == 0) return(cat("no step is selected"))
#'
#'     wf <- .make_plot(df_wf, plot_style, is_main_branch=FALSE)
#'     wf <- append(wf, .make_plot(df_wf, plot_style, is_main_branch=TRUE),
#'                  after = length(wf) - 1)
#'     # special case for detection style plotting, need to move unneeded
#'     # nodes out of main branch
#'     if (plot_style == "detect") wf <- .change_branch(df_wf, wf)
#'     # collapse entire graph
#'     # return(wf)
#'     wf <- paste0(wf, collapse = "")
#'     # plot
#'     plot <- switch(out_type,
#'            'shiny' = DOT::dot(wf, return = "verbatim"),
#'            'html' = DOT::dot(wf)
#'     )
#'     return(plot)
#' }

# .find_long_branch <- function(t_number, link_to){
#     track_back <- function(t_number, link_to, track_list){
#         for (each_track_n in seq_len(length(track_list))){
#             each_track = track_list[[each_track_n]] %>% unlist()
#             previous_t_number <-
#                 names(link_to_list[
#                     which(vapply(link_to_list,
#                            function(x) any(x == t_number[each_track[1]]),
#                            logical(1))
#                           )
#                     ]
#                 )
#             for (each_num in seq_len(length(previous_t_number))) {
#                 previous_link <- which(t_number == previous_t_number[each_num])
#                 newtrack = append(previous_link, each_track)
#                 if (each_num < 2){
#                     track_list[[each_track_n]] <- newtrack
#                 } else {
#                     track_list[[each_track_n + each_num - 1]] <- newtrack
#                 }
#             }
#         }
#         if (length(previous_t_number) == 0) return(track_list)
#         track_list <- track_back(t_number, link_to, track_list)
#         return(track_list)
#     }
#     link_to_list <- str_split(link_to, ",") %>%
#         lapply(function(x) str_remove_all(x, " "))
#     names(link_to_list) <- t_number
#     last_step <- list(length(t_number))
#             track_list <- track_back(t_number, link_to, last_step)
#     long <- vapply(track_list,
#                    function(x) all(c(1, length(t_number)) %in% x),
#                    logical(1)) %>%
#         track_list[.] %>%
#         vapply(length, FUN.VALUE = 1L) %>%
#         which.max() %>% track_list[.] %>%
#         unlist()
#     return(long)
# }
#
# .make_plot <- function(df_wf, plot_style, is_main_branch=TRUE){
#     if (is_main_branch){
#         # graph start
#         wf <- "subgraph { rank=same;\n"
#         df_wf <- switch(plot_style,
#             "detect"=df_wf[.find_long_branch(df_wf$t_number, df_wf$link_to), ],
#             "none"  =df_wf[0,],
#             "linear"={
#                 df_wf$link_to[seq_len(nrow(df_wf) - 1)] <-
#                     df_wf$t_number[seq_len(nrow(df_wf))[-1]]; df_wf
#             }
#         )
#     } else{
#         wf <- switch(plot_style,
#                      "detect" = "digraph { rankdir=LR;\n",
#                      "none"   = "digraph { rankdir=TB;\n",
#                      "linear" = "digraph { rankdir=LR;\n")
#         df_wf <- switch(plot_style,
#             "detect"=df_wf[-.find_long_branch(df_wf$t_number, df_wf$link_to), ],
#             "none"  =df_wf,
#             "linear"=df_wf[0,]
#         )
#     }
#     if (nrow(df_wf) == 0) return(c(wf, "}"))
#
#     steps <- df_wf$t_number
#     step_text <- str_replace_all(df_wf$t_text, '[\'\"]', "\\\\'")
#     link_to <- df_wf$link_to
#     # reslove 1 to n links
#     link_to <- str_split(link_to, ",") %>%
#         lapply(function(x) str_remove_all(x, " "))
#     # set up colors
#     step_color <- ifelse(
#         df_wf$no_run == 0,
#         'gray',
#         ifelse(
#             is.na(df_wf$no_run) | is.na(df_wf$no_success),
#             "black",
#             ifelse(df_wf$no_run != df_wf$no_success, 'red', 'green')
#         )
#     )
#     # dot language
#     # add steps
#     for (t in seq_along(steps)){
#         if (!is.na(link_to[t]) & t < length(steps)){
#             for (nlink in link_to[t]){
#                 wf <- append(
#                     wf,
#                     paste0('  n', str_replace_all(steps[t], "\\.", "_"), " -> ",
#                            '  n', str_replace_all(nlink, "\\.", "_"), ";\n")
#                 )
#             }
#         }
#     }
#     # add color, text
#     wf <- c(wf, paste0('  n', str_replace_all(steps, "\\.", "_"),
#                        ' [label=\"',
#                        steps, step_text, ' ',
#                        ifelse(
#                            df_wf$no_run == 0, '',
#                            paste0(df_wf$no_success, '/', df_wf$no_run)
#                        ),
#                        '\"', 'fontcolor=', step_color,
#                        ' color=white',
#                        '];\n'))
#     # end graph
#     wf <- paste0(c(wf, "}"))
#     return(wf)
# }
#
# .change_branch <- function(df_wf, wf){
#     long <- .find_long_branch(df_wf$t_number, df_wf$link_to)
#                     plot_start <- wf %>% str_which("digraph")
#     sub_start <- wf %>% str_which("subgraph ")
#     sub_steps_lines <- wf %>% str_which(" -> [^\\[]") %>% .[. > sub_start]
#     sub_number <- wf[sub_steps_lines] %>%
#         str_remove_all("[->;\n]") %>% str_remove("^.*[ ]+") %>%
#                 str_remove("n") %>% str_replace_all("_", "\\.") %>%
#         lapply(function(x) df_wf$t_number[df_wf$t_number == x]) %>%
#             unlist()
#     move_line_num <- sub_steps_lines[!sub_number %in% df_wf$t_number[long]]
#     if (length(move_line_num) == 0) return(wf)
#     move_lines <- wf[move_line_num]
#     wf <- wf %>% .[-move_line_num] %>% append(move_lines, after = plot_start)
#     return(wf)
# }
## Function used on this code:
# importFrom(magrittr,"%>%")
# importFrom("assertthat", "assert_that", "is.count")
# importFrom("stringr", "str_replace_all", "str_split",
#            "str_remove", "str_which", "str_remove_all")
# importFrom("DOT", "dot")
# importFrom(assertthat,"is.writeable")
# importFrom("rsvg,"rsvg_svg", "rsvg_png")

# #test code
# source("subsetRmd.R")
# df_wf = subsetRmd("YOUR.Rmd")
# df_wf$no_success[3:8] = 1
# df_wf$no_run[3:5] = 10
# df_wf$no_run[6:8] = 1
# df_wf$selected[1:35] = TRUE
# df_wf$link_to = NA
# df_wf$link_to[1:(nrow(df_wf) - 1)] = df_wf$t_number[2:nrow(df_wf)]
# df_wf$link_to[3] = NA
# df_wf$link_to[1] = "1.1, 2"
# df_wf$link_to[4] = "2.1, 3"
# df_wf$link_to[14] = NA
# df_wf = df_wf[1:17,]
# df_wf$link_to[8] = "3, 2.5"
# df_wf$selected = TRUE
# .plotWF(df_wf, plot_style = "linear")