fixVis/app.R

In abrown435/immunarch-test: Bioinformatics Analysis of T-Cell and B-Cell Immune Repertoires

#
# This is a Shiny web application. You can run the application by clicking
# the 'Run App' button above.
#
# Find out more about building applications with Shiny here:
#
#    http://shiny.rstudio.com/
#

library(shiny)
library(shinythemes)
library(ggplot2)

make_legend_tab <- function (.label, .name, .title.text, .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 = 2, step=1),
                         br(),
                         textInput(.full("text"), "Title text:", .title.text, 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)
}

# Define UI for application that draws a histogram
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 = 10),
                 sliderInput("plot_height", "Plot height (in):", min = 2, max = 20, value = 6),
                 checkboxInput("coord_flip", "Flip coordinates"),
                 # checkboxInput("do_interactive", "Interactive plot"),
                 selectInput("ggplot_theme", "Theme",
                             list("Linedraw",
                                  "Black-white" ,
                                  "Grey / gray",
                                  "Light",
                                  "Dark",
                                  "Minimal",
                                  "Classic"))),

        tabPanel("Title & subtitle",
                 br(),
                 tabsetPanel(tabPanel("Title",
                                      br(),
                                      textInput("title_text", "Title text:", "Diamonds dataset visualisation", 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:", "Load it via data(dataset)",
                                                    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)", "Colour", T),
                                                  make_legend_tab("col_text", "Labels (color)", "", F))),
                             tabPanel("Fill",
                                      tabsetPanel(make_legend_tab("fill_title", "Title (fill)", "Cut", T),
                                                  make_legend_tab("fill_text", "Labels (fill)", "", F))),
                             tabPanel("Size",
                                      tabsetPanel(make_legend_tab("size_title", "Title (size)", "Clarity", T),
                                                  make_legend_tab("size_text", "Labels (size)", "", F))),
                             tabPanel("Shape",
                                      tabsetPanel(make_legend_tab("shape_title", "Title (shape)", "Cut", T),
                                                  make_legend_tab("shape_text", "Labels (shape)", "", F))),
                             tabPanel("Linetype",
                                      tabsetPanel(make_legend_tab("linetype_title", "Title (linetype)", "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:", "Carat", 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 = 0, 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:", "Price", 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;")
    )
  )
)

# Define server logic required to draw a histogram
server <- function(input, output, session) {

  data("diamonds")
  .plot <- qplot(x = carat, y = price, fill = cut, shape = cut, color = color, size = clarity, data=diamonds[sample.int(nrow(diamonds), 5000),]) + theme_classic()

  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())
    }

    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$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")
    }
  )
  }

# Run the application
shinyApp(ui = ui, server = server)