R/shiny.R

In charlotterich/immunarch_code: Painless Bioinformatics Analysis of T-Cell and B-Cell Immune Repertoires in R

if (getRversion() >= "2.15.1") {
  utils::globalVariables(c("data", "carat", "price", "color", "clarity", "diamonds"))
}


#' Make publication-ready plots
#'
#' @importFrom graphics plot
#' @importFrom shiny fluidPage titlePanel sidebarLayout sidebarPanel downloadButton actionButton br
#' @importFrom shiny tabsetPanel tabPanel textOutput sliderInput checkboxInput selectInput textInput textAreaInput
#' @importFrom shiny mainPanel uiOutput renderText renderUI renderPlot plotOutput observe updateSliderInput
#' @importFrom shiny observeEvent downloadHandler splitLayout
#' @importFrom shinythemes shinytheme
#'
#' @description The \code{fixVis} is a built-in software tool for the manipulation
#' of plots, such as adjusting title text font and size, axes, and more. It is a powerful
#' tool designed to produce publication-ready plots with minimal amount of coding.
#'
#' @param .plot A ggplot2 plot.
#'
#' @return
#' No return value since it is an application.
#'
#' @examples
#' \dontrun{
#' # Compute gene usage, visualise it and tweak via fixVis
#' data(immdata) # load test data
#' gu = geneUsage(immdata$data)
#' p = vis(gu)
#' fixVis(p)
#' }
#' @export fixVis
fixVis <- function (.plot = NA) {

  make_legend_tab <- function (.label, .name, .is.title) {

    .full <- function (.l) {
      stringr::str_c("legend", .label, .l, sep = "_")
    }

    objs = list(title = .name)

    objs = c(objs, list(br()))

    if (.is.title) {
      objs = c(objs, list( splitLayout(cellWidths = c("60%", "40%"),
                                       checkboxInput(.full("remove"), "Remove the legend"),
                                       checkboxInput(.full("contin"), "Continuous?")),
                           sliderInput(.full("ncol"), "Number of columns:",
                                       min = 1, max = 40, value = 1, step=1),
                           br(),
                           textInput(.full("text"), "Title text:", .name, placeholder = "Samples")))
    }

    objs = c(objs, list(sliderInput(.full("size"), "Text size:",
                                    min = 1, max = 40, value = ifelse(.is.title, 16, 11), step=.5),
                        sliderInput(.full("hjust"), "Text horizontal adjustment:",
                                    min = 0, max = 1, value = 0, step=.05),
                        sliderInput(.full("vjust"), "Text vertical adjustment:",
                                    min = -4, max = 4, value = .5, step=.25),
                        sliderInput(.full("angle"), "Text angle:",
                                    min = 0, max = 90, value = 0, step=1),
                        selectInput(.full("face"), "Face:",
                                    list(Plain = "plain", Bold = "bold", Italic = "italic", "Bold Italic" = "bold.italic"))) )

    do.call(tabPanel, objs)
  }

  if (is.na(.plot)) {
    diamonds = ggplot2::diamonds
    .plot <- qplot(x = carat, y = price, fill = cut, shape = cut, color = color, size = clarity, data=diamonds[sample.int(nrow(diamonds), 5000),]) + theme_classic()
  }

  #
  #### UI ####
  #
  ui <- fluidPage(
    theme = shinytheme("cosmo"),
    titlePanel("FixVis: make your plots publication-ready already!"),

    sidebarLayout(
      sidebarPanel(
        downloadButton("save_plot", "Save"),
        actionButton("console_plot", "Plot to R console"),

        br(),
        br(),

        tabsetPanel(
          tabPanel("General",
                   br(),
                   textOutput("save_text"),
                   br(),
                   # textOutput("save_text2"),
                   # br(),
                   sliderInput("plot_width", "Plot width (in):", min = 2, max = 24, value = 8),
                   sliderInput("plot_height", "Plot height (in):", min = 2, max = 20, value = 5),
                   checkboxInput("coord_flip", "Flip coordinates"),
                   # checkboxInput("do_interactive", "Interactive plot"),
                   selectInput("ggplot_theme", "Theme", selected = "Pubr",
                               list("Linedraw",
                                    "Black-white" ,
                                    "Grey / gray",
                                    "Light",
                                    "Dark",
                                    "Minimal",
                                    "Classic",
                                    "Pubr",
                                    "Pubr w/o lines"))),

          tabPanel("Title & subtitle",
                   br(),
                   tabsetPanel(tabPanel("Title",
                                        br(),
                                        textInput("title_text", "Title text:", "nice title text", placeholder = "Gene usage"),
                                        sliderInput("title_text_size", "Title text size:",
                                                    min = 1, max = 40, value = 25, step=.5),
                                        sliderInput("title_text_hjust", "Title text horizontal adjustment:",
                                                    min = 0, max = 1, value = 0, step=.05),
                                        sliderInput("title_text_vjust", "Title text vertical adjustment:",
                                                    min = -4, max = 4, value = .5, step=.25),
                                        sliderInput("title_text_angle", "Title text angle:",
                                                    min = 0, max = 90, value = 0, step=1),
                                        selectInput("title_face", "Face:",
                                                    list(Plain = "plain", Bold = "bold", Italic = "italic", "Bold Italic" = "bold.italic"))),

                               tabPanel("Subtitle",
                                        br(),
                                        textAreaInput("subtitle_text", "Subtitle text:", "nice subtitle text",
                                                      placeholder = "Frequency of Variable gene segments presented in the input samples"),
                                        sliderInput("subtitle_text_size", "Subtitle text size:",
                                                    min = 1, max = 40, value = 16, step=.5),
                                        sliderInput("subtitle_text_hjust", "Subtitle text horizontal adjustment:",
                                                    min = 0, max = 1, value = 0, step=.05),
                                        sliderInput("subtitle_text_vjust", "Subtitle text vertical adjustment:",
                                                    min = -4, max = 4, value = .5, step=.25),
                                        sliderInput("subtitle_text_angle", "Subtitle text angle:",
                                                    min = 0, max = 90, value = 0, step=1),
                                        selectInput("subtitle_face", "Face:",
                                                    list(Plain = "plain", Bold = "bold", Italic = "italic", "Bold Italic" = "bold.italic"))))
                   ),

          tabPanel("Legends",
                   br(),
                   selectInput("legend_position", "Legend position",
                               list("right",
                                    "top" ,
                                    "bottom",
                                    "left")),
                   selectInput("legend_box", "Legend arrangement",
                               list("vertical",
                                    "horizontal")),
                   tabsetPanel(tabPanel("Color",
                                        tabsetPanel(make_legend_tab("col_title", "Title (color)", T),
                                                    make_legend_tab("col_text", "Labels (color)", F))),
                               tabPanel("Fill",
                                        tabsetPanel(make_legend_tab("fill_title", "Title (fill)", T),
                                                    make_legend_tab("fill_text", "Labels (fill)", F))),
                               tabPanel("Size",
                                        tabsetPanel(make_legend_tab("size_title", "Title (size)", T),
                                                    make_legend_tab("size_text", "Labels (size)", F))),
                               tabPanel("Shape",
                                        tabsetPanel(make_legend_tab("shape_title", "Title (shape)", T),
                                                    make_legend_tab("shape_text", "Labels (shape)", F))),
                               tabPanel("Linetype",
                                        tabsetPanel(make_legend_tab("linetype_title", "Title (linetype)", T),
                                                    make_legend_tab("linetype_text", "Labels (linetype)", F)))
                               )
                   ),

          tabPanel("X axis",
                   br(),
                   tabsetPanel(tabPanel("X title",
                                        br(),
                                        textInput("x_text", "X axis label:", "x axis text", placeholder = "V genes"),
                                        checkboxInput("apply_x2y", "Apply X axis settings to Y axis"),
                                        br(),
                                        sliderInput("x_title_size", "X axis title text size:",
                                                    min = 1, max = 40, value = 16, step=.5),
                                        sliderInput("x_title_hjust", "X axis title text horizontal adjustment:",
                                                    min = 0, max = 1, value = 0.5, step=.05),
                                        sliderInput("x_title_vjust", "X axis title text vertical adjustment:",
                                                    min = -4, max = 4, value = .5, step=.25),
                                        sliderInput("x_title_angle", "X axis title text angle:",
                                                    min = 0, max = 90, value = 0, step=1),
                                        selectInput("x_title_face", "Face:",
                                                    list(Plain = "plain", Bold = "bold", Italic = "italic", "Bold Italic" = "bold.italic"))),

                               tabPanel("X ticks",
                                        br(),
                                        sliderInput("x_text_size", "X axis text size:",
                                                    min = 1, max = 40, value = 11, step=.5),
                                        sliderInput("x_text_hjust", "X axis text horizontal adjustment:",
                                                    min = -2, max = 2, value = .5, step=.1),
                                        sliderInput("x_text_vjust", "X axis text vertical adjustment:",
                                                    min = -4, max = 4, value = .5, step=.25),
                                        sliderInput("x_text_angle", "X axis text angle:",
                                                    min = 0, max = 90, value = 90, step=1),
                                        selectInput("x_text_face", "Face:",
                                                    list(Plain = "plain", Bold = "bold", Italic = "italic", "Bold Italic" = "bold.italic"))))
                   ),

          tabPanel("Y axis",
                   br(),
                   tabsetPanel(tabPanel("Y title",
                                        br(),
                                        textInput("y_text", "Y axis label:", "y axis text", placeholder = "Gene frequency"),
                                        checkboxInput("apply_y2x", "Apply Y axis settings to X axis"),
                                        br(),
                                        sliderInput("y_title_size", "Y axis title text size:",
                                                    min = 1, max = 40, value = 16, step=.5),
                                        sliderInput("y_title_hjust", "Y axis title text horizontal adjustment:",
                                                    min = 0, max = 1, value = 0.5, step=.05),
                                        sliderInput("y_title_vjust", "Y axis title text vertical adjustment:",
                                                    min = -4, max = 4, value = .5, step=.25),
                                        sliderInput("y_title_angle", "Y axis title text angle:",
                                                    min = 0, max = 90, value = 90, step=1),
                                        selectInput("y_title_face", "Face:",
                                                    list(Plain = "plain", Bold = "bold", Italic = "italic", "Bold Italic" = "bold.italic"))),

                               tabPanel("Y ticks",
                                        br(),
                                        sliderInput("y_text_size", "Y axis text size:",
                                                    min = 1, max = 40, value = 11, step=.5),
                                        sliderInput("y_text_hjust", "Y axis text horizontal adjustment:",
                                                    min = -2, max = 2, value = .5, step=.1),
                                        sliderInput("y_text_vjust", "Y axis text vertical adjustment:",
                                                    min = -4, max = 4, value = .5, step=.25),
                                        sliderInput("y_text_angle", "Y axis text angle:",
                                                    min = 0, max = 90, value = 0, step=1),
                                        selectInput("y_text_face", "Face:",
                                                    list(Plain = "plain", Bold = "bold", Italic = "italic", "Bold Italic" = "bold.italic"))))
                   )
        )),

      mainPanel(
        uiOutput("main_plot", style = "position:fixed;")
      )
    )
  )


  #
  #### SERVER ####
  #
  server <- function(input, output, session) {

    create_plot <- function (input) {

      # TODO: make automatic detection of available themes from ggplot2 and other packages
      choose_theme <- function (theme_label) {
        switch (theme_label,
                Linedraw = theme_linedraw(),
                `Black-white` = theme_bw(),
                `Grey / gray` = theme_gray(),
                `Light` = theme_light(),
                `Dark` = theme_dark(),
                `Minimal` = theme_minimal(),
                `Classic` = theme_classic(),
                `Pubr` = theme_pubr(),
                `Pubr w/o lines` = theme_pubr())
      }

      check_empty_str <- function (.str) {
        if (.str == "" || .str == "\n" || .str == "\t") {
          NULL
        } else {
          .str
        }
      }

      get_legend_params <- function (.input, .label) {

        .get <- function (.l) {
          .input[[stringr::str_c("legend", .label, .l, sep = "_")]]
        }

        .remove = .get("title_remove")

        if (.remove) {
          F  # return F to pay respects (please remove it in the next release)
        } else {

          guide_fun = guide_legend
          if (.get("title_contin")) {
            guide_fun = guide_colorbar
          }

          guide_fun(
            title = .get("title_text"),
            ncol = .get("title_ncol"),
            title.theme = element_text(size  = .get("title_size"),
                                       hjust = .get("title_hjust"),
                                       vjust = .get("title_vjust"),
                                       angle = .get("title_angle"),
                                       face  = .get("title_face")),

            label.theme = element_text(size  = .get("text_size"),
                                       hjust = .get("text_hjust"),
                                       vjust = .get("text_vjust"),
                                       angle = .get("text_angle"),
                                       face  = .get("text_face"))
            )
        }
      }

      .plot = .plot +
        choose_theme(input$ggplot_theme) +
        labs(x = check_empty_str(input$x_text),
             y = check_empty_str(input$y_text),
             title = check_empty_str(input$title_text),
             subtitle = check_empty_str(input$subtitle_text),
             fill = input$legend_text,
             color = input$legend_text) +
        guides(col = get_legend_params(input, "col"),
               fill = get_legend_params(input, "fill"),
               size = get_legend_params(input, "size"),
               shape = get_legend_params(input, "shape"),
               linetype = get_legend_params(input, "linetype")) +
        theme(plot.title = element_text(size=input$title_text_size,
                                        hjust=input$title_text_hjust,
                                        vjust=input$title_text_vjust,
                                        angle=input$title_text_angle,
                                        face = input$title_face),
              plot.subtitle = element_text(size=input$subtitle_text_size,
                                           hjust=input$subtitle_text_hjust,
                                           vjust=input$subtitle_text_vjust,
                                           angle=input$subtitle_text_angle,
                                           face = input$subtitle_face),
              legend.position = input$legend_position,
              legend.box = input$legend_box,
              axis.title.x = element_text(size=input$x_title_size,
                                         hjust=input$x_title_hjust,
                                         vjust=input$x_title_vjust,
                                         angle=input$x_title_angle,
                                         face = input$x_title_face),
              axis.title.y = element_text(size=input$y_title_size,
                                         hjust=input$y_title_hjust,
                                         vjust=input$y_title_vjust,
                                         angle=input$y_title_angle,
                                         face = input$y_title_face),
              axis.text.x = element_text(size=input$x_text_size,
                                         hjust=input$x_text_hjust,
                                         vjust=input$x_text_vjust,
                                         angle=input$x_text_angle,
                                         face = input$x_text_face),
              axis.text.y = element_text(size=input$y_text_size,
                                         hjust=input$y_text_hjust,
                                         vjust=input$y_text_vjust,
                                         angle=input$y_text_angle,
                                         face = input$y_text_face))
      if (input$ggplot_theme == "Pubr") {
        .plot = .plot + theme_cleveland2()
      }

      if (input$coord_flip) {
        .plot = .plot + coord_flip()
      }

      .plot
    }

    output$save_text = renderText({'To save the plot, press the "Save" button above or drag-n-drop
      the plot to your Desktop or into any file manager (Finder, File Explorer, etc.)'})
    output$save_text2 = renderText({'Note: saving via the "Save" button will be different from the drag-n-drop method
      due to R\'s peculiar properties.'})

    output$main_plot = renderUI({
      # if (input$do_interactive) {
      # output$main_plot_helper = renderPlotly(ggplotly(create_plot(input)))
      # plotlyOutput("main_plot_helper")
      # } else {
      output$main_plot_helper = renderPlot(create_plot(input))
      plotOutput("main_plot_helper", width = input$plot_width*72, height = input$plot_height*72)
      # }
    })

    #
    # Assign X settings to Y
    #
    observe({
      if (!is.null(input$apply_x2y)) {
        if (input$apply_x2y) {
          updateSliderInput(session, "y_title_size", value = input$x_title_size)
          updateSliderInput(session, "y_title_hjust", value = input$x_title_size)
          updateSliderInput(session, "y_title_vjust", value = input$x_title_size)
          updateSliderInput(session, "y_title_angle", value = input$x_title_size)

          updateSliderInput(session, "y_text_size", value = input$x_text_size)
          updateSliderInput(session, "y_text_hjust", value = input$x_text_size)
          updateSliderInput(session, "y_text_vjust", value = input$x_text_size)
          updateSliderInput(session, "y_text_angle", value = input$x_text_size)
        }
      }
    })

    #
    # Vice versa: assign Y settings to X
    #
    observe({
      if (!is.null(input$apply_y2x)) {
        if (input$apply_y2x) {
          updateSliderInput(session, "x_title_size", value = input$y_title_size)
          updateSliderInput(session, "x_title_hjust", value = input$y_title_hjust)
          updateSliderInput(session, "x_title_vjust", value = input$y_title_vjust)
          updateSliderInput(session, "x_title_angle", value = input$y_title_angle)

          updateSliderInput(session, "x_text_size", value = input$y_text_size)
          updateSliderInput(session, "x_text_hjust", value = input$y_text_hjust)
          updateSliderInput(session, "x_text_vjust", value = input$y_text_vjust)
          updateSliderInput(session, "x_text_angle", value = input$y_text_angle)
        }
      }
    })

    observeEvent(input$console_plot, {
      plot(create_plot(input))
    })

    #
    # Save plots
    #
    output$save_plot = downloadHandler(
      filename = paste0("plot shiny ", Sys.time(), ".png"),
      content = function(file) {
        ggsave(file, plot = create_plot(input), width = input$plot_width, height = input$plot_height, device = "png")
      }
    )
    }

  shiny::shinyApp(ui = ui, server = server)
}