fixVis/app.R

In immunomind/immunarch: 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)